forme auto en vbaRésolu

Question

bonjour,
lorque l'on crée un rectangle avec VBA (excel) il à un numéro choisi par le programme . exemple: "rectagle 6"
pour des raison  personnel compliqué à expliquer, je recrée ces rectangle à chaque ouverture du fichier (auto_open). malheureusement le numéro change et le "rectangle 6" peu devenir le rectangle 7 à la prochaine ouverture.
de ce faite mes macro se servant du "rectangle 6"ne fonctionne plus puisqu'il n'exite plus.
comment faire pour figer ce numéro, voir comment lui donné un nom genre "rectangle toto" à sa création?
merci d'anvance

ma passion c'est d'apprendre.

us_30 · Accepted Answer

... reste que ma dernière remarque est encore d'actualité...

Voici le code modifié qui devrait résoudre ton problème :

=

Sub ess()



    'Test existence de "rectangle toto" :
    Dim ole1 As Object
    For Each ole1 In Feuil1.Shapes
        If UCase(ole1.Name) = UCase("rectangle toto") Then Exit Sub
        'Si un object de la Feuil1 possède le nom en majuscule "RECTANGLE TOTO"
        'alors quitte la procédure
    Next



    'Dessine un nouveau rectangle :
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 500, 200, 100, 30).Select
    
    'Avec ce rectangle sélectionné applique lui les propriétés suivantes :
    With Selection
    .Name = "Rectangle toto" 'donne ce nom à l'objet sélectionné nouvellement créé
        With .ShapeRange.Fill
            .ForeColor.SchemeColor = 43
            .Visible = msoTrue
            .Solid
        End With
        With .Characters(Start:=1, Length:=11)
            .Text = "hfghfghfghd"
                With .Font
                .Name = "Arial"
                .FontStyle = "Normal"
                .Size = 10
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                End With
        End With
    End With



End Sub


=

Je passe en revue tous les objets de la feuil1, et si on trouve l'objet "rectangle toto" alors on sort, sinon on en dessin un en lui affectant le nom "rectangle toto" pour le repérer la prochaine fois...

Amicalement,
Us.

Renfield · Answer

qual code utilises tu pour créer ce fameux rectangle ?

us_30 · Answer

Pour définir un nom à ton objet, utilise la propriété NAME :

par exemple :



ActiveChart.Shapes("Rectangle 6").Name = "Rectangle toto"



mais reste à savoir si tu organises correctement ta programmation, car dans le principe tu poses un problème de logique... 

Amicalement,
Us.

daiman · Answer

bonjour,
voilà le genre de code que j'utilise.

Sub auto_open()
'
'
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 500, 200, 100, 30). _
        Select
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.Characters.Text = "hfghfghfghd"
    With Selection.Characters(Start:=1, Length:=11).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    
End Sub

ma passion c'est d'apprendre.

daiman · Answer

bonjour us_30,

ActiveChart.Shapes("Rectangle 6").Name = "Rectangle toto"



le souci de ton code c'est que lorsque j'ouvre mon fichier le rectangle 6 n'est  plus le rectangle 6. il a déjà changé de nom.
en faite, si je trouve le moyen de faire en sort que c'est fameux rectangle ne puissent pas être supprimé ni être modifié cela me sufirait. sachant quand même que la feuille elle eest modifiable.

ma passion c'est d'apprendre.

daiman · Answer

après essais j'ai quand même quelques questions.
pourquoi recherche rectangle toto en majuscule?
à l'interieur des rectangle je met un text.
il y a t-il un moyen des comparer le texte avec un texte bon, de façon à être sur qu'il n'a pas été modifié?

ma passion c'est d'apprendre.

us_30 · Answer

Ici je met la convertion en majuscule pour m'éviter de me poser des questions sur le formattage du nom... c'est tout. Si tu veux, tu peux écrire :
If ole1.Name = "Rectangle toto" Then Exit Sub
donc ave c une majuscule pour la première lettre et le reste en minuscule... par contre si tu ne respectes pas cette condition de formatage, le test ne sera plus probant...

Pour remettre le texte à l'identique, ce n'est pas plus difficile, et tu as deux solutions (au moins), soit tu effaces complètement l'objet puis le refait (comme ça même si la police à changer, elle reviendra à l'identique), soit tu redéfinis le texte juste après le test ci-dessus. Par exemple : 

If UCase(ole1.Name) = UCase("rectangle toto") Then
   ole1.Sele
   Selection.Characters.Text = "hfghfghfghd"
   Exit Sub
End If

Amicalement,
Us.

daiman · Answer

la boucle for ne fonctionne pas?
For Each ole1 In Feuil1.Shapes
        If UCase(ole1.Name) = UCase("rectangle toto") Then Exit Sub
        'Si un object de la Feuil1 possède le nom en majuscule "RECTANGLE TOTO"
        'alors quitte la procédure
    Next

ma passion c'est d'apprendre.

us_30 · Answer

Oupsss... bizard la mise en forme... je reprend le code tronqué :

If UCase(ole1.Name) = UCase("rectangle toto") Then
   ole1.Select
   Selection.Characters.Text = "hfghfghfghd"
   Exit Sub
End If

Rq en passant : Simplifie encore la ligne :
.Characters(Start:=1, Length:=11)
par
.Characters
pour éviter de calculer la longueur précise du texte...

Us.

us_30 · Answer

éh... j'ai même pas le temps de répondre... minute...

Comment ça la boucle ne fonctionne pas ? ! Cela marche très bien chez moi... Que dit le message d'erreur ?

Us.

daiman · Answer

excuse moi US. en faite, je n'ai pas compris ta boucle ...pour les majuscule??? je l'ai refaite ma façon. elle fonctionne quand elle en a envie!!!. j'ai finalement compris pourquoi et je vais tenté de te l'expliquer, en espérent que tu auras la solution. au début de cette histoir je voulais mettre des infos bulles lorsque l'on passe la souris sur un bouton. pour cela j'ai crée des rectangles avec un text dedans et grace à un code que j'ai repris sur le forum le rectangle apparais ou disparait au grée de la souris. mais je me suis aperçu que de temps en temps le rectangle bloquais suffisament longtemp pour que l'on puissent faire un clic dessus et là! on pouvait modifier le text et même le supprimer. j'ai donc cherché à palier ce problème. en recréant le rectangle avec le bon text à chaque nouvelle ouverture du fichier ma paraissait être une solution accèptable. du coup, le rectangle étant invisible la boucle for ne fonctionne pas.......voilà. voila ou j'en suis. mais si tu une solution pour éviter que l'on puissent modifier mon re"ctangle je suis preneur. PS: code "info bulle" Private Sub CommandButton1_Click() End Sub Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If X < 10 Or X > CommandButton1.Width - 10 Or Y < 10 Or Y > CommandButton1.Height - 10 Then ActiveSheet.Shapes("Rectangle toto").Visible = False Else ActiveSheet.Shapes(" Rectangle toto ").Visible = True End If End Sub ma passion c'est d'apprendre.

daiman · Answer

voilà ton code modifié mais du tout au point.

Sub auto_open()


    'Test existence de "rectangle toto" :
    
    Dim ole1 As Object
    For Each ole1 In Feuil1.Shapes
  
        If ole1.Name = "Rectangle toto" Then
        ActiveSheet.Shapes("Rectangle toto").Select
        Selection.Characters.Text = _
        "Le clic sur ce bouton est la première chose à faire si vous n'avez de données dans la feuille ""Données Brut"". Dans cette feuille ce trouve la base de votre travail. De ce faite il faut évité de faire "
    Selection.Characters(201).Insert String:= _
        "de la manipulation dans ""Données Brut"" autre que celles proposés par les boutons du haut. " & Chr(10) & "Si le fichier importé est différent d'un RMP05 ou RMP02 ou ROT02 alors il est possible que la plupart de"
    Selection.Characters(401).Insert String:= _
        "s services offert par les bouton ne fonctionne pas normalement." & Chr(10) & "Théoriquement les boutons ""Recherche"", ce trouvant dans chaque pages, fonctionne avec n'importe quel fichier," & Chr(10) & ""
        Range("a1").Select
         ActiveSheet.Shapes("Rectangle toto").Visible = False
        Exit Sub
        End If
        'Si un object de la Feuil1 possède le nom en majuscule "RECTANGLE TOTO"
        'alors quitte la procédure
    Next


    'Dessine un nouveau rectangle :
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 390, 50, 400, 120).Select
    
    'Avec ce rectangle sélectionné applique lui les propriétés suivantes :
    With Selection
    .Name = "Rectangle toto" 'donne ce nom à l'objet sélectionné nouvellement créé
        With .ShapeRange.Fill
            .ForeColor.SchemeColor = 43
            .Visible = msoTrue
            .Solid
        End With
        With .Characters(Start:=1, Length:=11)
                .Text = "alix1"

ma passion c'est d'apprendre.

us_30 · Answer

Attends... attends... Si tu veux une infobulle sur le bouton, pourquoi ne pas utiliser sa propriété "ControlTipText" ?? comme tout le monde, c'est comme même le plus simple... Tu es en train de te compliquer vraiment la vie... (et surement pour pas grand chose... perds ton temps sur les choses essentielles...)

JE regarderai demain ton code, si "ControlTipText" n'apporte vraiment pas satisfaction... 

Amicalement,
Us.

Forme auto en vba

13 réponses

Votre réponse

Discussions similaires