Macro qui se met à jour

Bonjour à toutes et tous

Suite à ce sujet https://forum.excel-pratique.com/excel/macro-pour-creation-bandeau-sommaire-et-saut-de-page-t18494.html j'ai pas mal bossé sur mon fichier.

@modos: du coup pouvez vous supprimer ledit sujet svp? Il ne sert plus à rien

J'ai créé un petit code (Module "Bandeau3") donc le but est de créer des bandeaux dans un tableau, puis de créer un sommaire qui renvoie vers chaque bandeau.

Le code donne ceci:

Sub Bandeau3()

    Application.ScreenUpdating = False                      'Pour éviter les scintillements
    Application.DisplayAlerts = False                       'Enlever les alertes

    'Création du bandeau

    Range("LastLineLimit").Offset(-1).Select                'Sélection de la ligne avant dernière
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    With Selection                                          'Fusion et hauteur de ligne
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .RowHeight = 39
    End With
    Selection.Merge
    With Selection.Interior                                 'Couleur de l'intérieur
        .ColorIndex = 37
    End With
    ActiveCell.FormulaR1C1 = "Unité 2 (Nom de l'UT)" 'Saisie et mise en forme
    With ActiveCell.Characters(Start:=1, Length:=21).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
    End With

    'Définition du nom du bandeau pour le lien hypertexte

     Sheets("Document Unique").Select
    Range("LastLineLimit").Offset(-2).Select                'Sélection du dernier bandeau créé
    ActiveWorkbook.Names.Add Name:="Unite2", RefersToR1C1:= _
    Range("LastLineLimit").Offset(-2)                       'Définition d'un nom du bandeau

    'Mise en place du sommaire

    Sheets("Sommaire").Select
    Range("LastSommaire").Offset(-1).Select                 'Sélection de l'avant dernière ligne
    With Selection                                          'Fusion et hauteur
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .RowHeight = 40
    End With
    With Selection.Interior                                 'Couleur de l'intérieur
        .ColorIndex = 37
    End With

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone    'Mise en forme des bordures
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With

    'Création du lien hypertexte

    Sheets("Sommaire").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "Unite2", TextToDisplay:="Unité 2 (Nom de l'UT)"     'Mise en place du lien hypertexte

    'Mise en forme contenu puis Retour au bandeau par clic sur le lien hypertexte

    Range("LastSommaire").Offset(-2).Select
    With Selection.Font                                     'Copie du texte du Bandeau et mise en forme
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 11
        .ColorIndex = 1
    End With
    Selection.Font.Bold = True

    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True   'Retour au bandeau

    Application.DisplayAlerts = True                        'Remise en fonctionnement des alertes

End Sub

(je suis débutant donc je mets plein d'explications pour m'y retrouver

Le problème est qu'en fait je voudrais qu'un clic ne fasse qu'un seul bandeau et un seul sommaire mais que s'il existe déjà un bandeau Unité 1, le nouveau s'appelle Unité 2, puis Unité 3 etc... et pareil dans le sommaire, de préférence sans limite, mais on peut en définir une (à Unité 100 par exemple).

J'ai essayé avec For To mais en fait ça fait une boucle donc ça crée X bandeaux à la fois...

En clair il faudrait que si le nom Unite2 est déjà pris (car le bandeau "Unité 2" créé), la macro le reconnaisse et nomme automatiquement le bandeau qu'on créera après Unite3 (Avec le titre "Unité 3 (Nom de l'UT)"). Mais je ne sais pas par quoi remplacer les "2" dans la définition du nom du bandeau et la création du lien hypertexte... :/

Je vous joins le fichier pour plus de compréhension

Est-ce que quelqu'un sait comment faire svp?

Merci d'avance

-- 13 Aoû 2010, 14:41 --

Personne n'a d'idée?

23du-v1-6-3.zip (79.83 Ko)

Bonsoir,

Si tu n'as pas + de réponses, c'est que toi seul sait comment çà marche (ton fichier)

Essaye d'exposer ton problème sur un exemple simple,

tu adapteras ensuite sur le fichier réel.

Amicalement

Claude

Yop

Merci Claude de ta réponse, et désolé il est vrai que lorsqu'on ne connait pas le fichier c'est assez complexe, je ne m'en étais pas rendu compte :/

Comme tu le dis, faire simple c'est le plus compliqué, alors j'ai simplifié à l'extrême

En clair ma demande:

Voici un mini bout de code:

Sub Variable()

    Range("A1").Select
    ActiveCell.FormulaR1C1 = "A=X"

End Sub

Ce code, à chaque clic sur un bouton, saisit "A=X" en A1.

Ce que je voudrais, c'est qu'au premier clic il saisisse "A=1", au second "A=2", au troisième "A=3" et ainsi de suite, de préférence sans limite (après s'il y a une limite je ferai avec, tant qu'elle n'est pas en dessous de 30 )

Et il faut bien qu'on clique, il ne faut pas qu'il affiche tout d'un coup (j'avais essayé avec une boucle...)

Est-ce faisable?

Merci d'avance

Bonjour,

C'est le chiffre 1, 2... que tu veux en A1 ou "A=1", "A=2" en A1 ??

Ce ne serait pas plutôt un chiffre qui s'incrémente dans la cellule A1 ??

A te relire

Bonjour,

Tu affecte une cellule de ton choix comme compteur (ici H1)

et suivant besoin

Sub EcritFormule()
    Range("h1") = Range("h1") + 1
    Range("a1") = "=""A = ""&h1"
End Sub
Sub EcritRésultat()
    Range("h1") = Range("h1") + 1
    Range("a1") = Range("h1")
End Sub

Amicalement

Claude

23sl2118-compteur.zip (12.64 Ko)

Bonjour

Je teste ta solution tout de suite Claude, je te tiens au courant

merci

-- 16 Aoû 2010, 11:23 --

Un compteur comment ai-je pu ne pas y penser

La solution à l'air pas mal, mais il reste encore un souci...

En fait la macro définit également un nom à la plage de cellules sélectionnées. Ce nom contient aussi ce chiffre qui s'incrémente au fur et à mesure (en clair, le premier nom c'est "Unite1", le second "Unite2" etc...)

Or quand je mets "Unite""&h1" pour la définition du nom, ça ne fonctionne pas :/

La ligne de code qui bug:

ActiveWorkbook.Names.Add Name:="Unite""&b3", RefersToR1C1:= _
    Range("LastLineLimit").Offset(-2) 

@Dan: le système que Dubois propose répond bien à ma problématique, en fait il s'agit juste d'un nombre qui s'incrémente tout seul à chaque clic et qui se place gentiment dans la cellule où je lui demande d'aller ^^

Merci pour votre aide précieuse

re,

Si le compteur est en B3

ActiveWorkbook.Names.Add Name:="Unite" & Range("b3"), RefersToR1C1:= _
Range("LastLineLimit").Offset(-2, 0)

le décalage s'écrit .Offset(ligne,colonne)

Claude

Yop

Merci ça fonctionne pour la définition du nom, maintenant je n'ai plus qu'une question (après je ne vous embête plus promis )

J'ai définit le nom "Unite" & Range("b3") pour pouvoir faire un lien hypertexte dessus. Or, dans la macro pour définir le lien hypertexte, il ne reconnait pas l'adresse (SubAdress). Comment faut-il l'écrire pour qu'il la reconnaisse? (Ci dessous j'ai essayé avec une variable ^^ raté )

    Unit = "Unite" & Range("b3")
    UnitName = "Unité " & Sheets("Document Unique").Range("b3").Value

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    Unit, TextToDisplay:=UnitName  

Merci encore pour tout, on approche de la fin

PS: Pour ça:

ActiveWorkbook.Names.Add Name:="Unite" & Range("b3"), RefersToR1C1:= _
Range("LastLineLimit").Offset(-2, 0)

En fait "LastLineLimit" est une ligne entière, donc du coup pas besoin de la référence de colonne Ou en tout cas ça fonctionne sans

Merci quand même

Yop

J'ai trouvé deux ou trois choses, par conséquent j'ai édité mon dernier post

Plus qu'un seul souci à résoudre: le paramètre SubAddress du lien hypertexte (cf mon post précédent)

Merci encore de votre aide précieuse

Amicalement

Yop

Personne n'a d'idée?

N'hésitez pas à me dire s'il est préférable que je crée un nouveau topic (le problème final n'est pas le même que celui dans le titre )

Qui plus est je ne trouve nulle part d'aide sur la fonction SubAddress....

Amicalement

Yop

Je commence à me demander si c'est possible de faire ça en fait... je ne trouve la solution nulle part

Merci encore de toute l'aide que vous apportez c'est vraiment super

Amicalement

Bonjour,

Remets ton fichier en ligne dans l'état où il se trouve où au moins le code complet. Ce sera plus simple de comprendre.

Oki voici le fichier

Dans l'onglet "Document Unique", lorsqu'on clique sur le bouton "Nouvelle Unité", ça déclenche la macro "bandeau3" que voici:

Sub Bandeau3()

    Application.ScreenUpdating = False                      'Pour éviter les scintillements
    Application.DisplayAlerts = False                       'Enlever les alertes

     'Création du compteur

    Range("b3") = Range("b3") + 1

    'Création du bandeau

    Range("LastLineLimit").Offset(-1).Select                'Sélection de la ligne avant dernière
    With Selection                                          'Fusion et hauteur de ligne
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .RowHeight = 39
    End With
    Selection.Merge
    With Selection.Interior                                 'Couleur de l'intérieur
        .ColorIndex = 37
    End With
    ActiveCell.FormulaR1C1 = "Unité " & Range("b3") & " (Nom de l'UT)" 'Saisie et mise en forme
    With ActiveCell.Characters(Start:=1, Length:=24).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 12
    End With

    'Définition du nom du bandeau pour le lien hypertexte

    ActiveWorkbook.Names.Add Name:="Unite" & Range("b3"), RefersToR1C1:= _
    Range("LastLineLimit").Offset(-2)

    'Mise en place du sommaire

    Sheets("Sommaire").Select
    Range("LastSommaire").Offset(-1).Select                 'Sélection de l'avant dernière ligne
    With Selection                                          'Fusion et hauteur
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .RowHeight = 40
    End With
    With Selection.Interior                                 'Couleur de l'intérieur
        .ColorIndex = 37
    End With

    'Création du lien hypertexte

    Unit = Range("LastLineLimit").Offset(-2)
    UnitName = "Unité " & Sheets("Document Unique").Range("b3").Value

    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
    "Unité" & Range("b3"), TextToDisplay:=UnitName                              'Mise en place du lien hypertexte

    'Mise en forme contenu puis Retour au bandeau par clic sur le lien hypertexte

    With Selection.Font                                     'Copie du texte du Bandeau et mise en forme
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 11
        .ColorIndex = 1
    End With

    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True   'Retour au bandeau

    Application.DisplayAlerts = True                        'Remise en fonctionnement des alertes

End Sub

Le problème est que la définition du lien hypertexte ne fonctionne pas...

  , SubAddress:= _
    "Unité" & Range("b3")

cette ligne la bug, elle en définit que "Unité" comme SubAdress.

La question est: comment faire pour qu'elle définisse le nom créé par la macro (pour le texte j'ai réussi avec UnitName, mais ça ne fonctionne pas avec Unit pour le SubAdress).

Merci encore

29du-v1-7-2.zip (74.08 Ko)

Yop

Est-ce réalisable alors selon vous?

Merci d'avance

Rechercher des sujets similaires à "macro qui met jour"