Probleme avec bouton activeX

Le 05/10/2013 à 01:15

Bonjour, désolé mais j'ai encore besoin de vous.

J'ai un problème avec mon bouton Active x qui disparait chaque fois, je dois toujours le recréer.

Je pense avoir trouver le problème dans ce code qui efface les image, je pense que c'est lui qui me fait le coup.

Par quoi je pourrais remplacer le code ci dessous pour qu'il ne disparaisse plus.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = 0

Rows("45:101").EntireRow.Hidden = False
If Range("Y29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True
Application.ScreenUpdating = -1

Dim objFeuille As Worksheet, objPict As Picture

Set objFeuille = ActiveSheet
objFeuille.Pictures.Delete

C'est ici le problème

If Worksheets("Newfacture").Range("N41").Value = 1 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("P43") & "\admin1.jpg")
With objPict
.Left = Range("E43").Left
.Top = Range("E43").Top
.Width = Range("E43").Width
.Height = Range("E43").Height
End With
End If
If Worksheets("Newfacture").Range("N41").Value = 2 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("P43") & "\admin2.jpg")
With objPict
.Left = Range("E43").Left
.Top = Range("E43").Top
.Width = Range("E43").Width
.Height = Range("E43").Height
End With
End If

etc jusqu’à End Sub

Merci

Le 05/10/2013 à 10:40

Bonjour,

C'est cette ligne qui supprime le bouton :

objFeuille.Pictures.Delete

Si tu veux supprimer une image particulière, indique sont nom directement :

ActiveSheet.Shapes("Nom de l'image").Delete

Par contre, si tu ne veux pas supprimer un Shape particulier, il te faut faire une boucle et contrôler le nom avant suppression :

For Each Sh In ActiveSheet.Shapes

    If Sh.Name <> "NomDuBouton" Then Sh.Delete

Next Sh

Tu ne poste qu'une partie de ton code mais je crois que tu peux le simplifier de cette façon, adapte le nom du bouton :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim objFeuille As Worksheet
    Dim objPict As Picture
    Dim Sh As Shape

    Application.ScreenUpdating = 0

    Rows("45:101").EntireRow.Hidden = False
    If Range("Y29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True

    Application.ScreenUpdating = -1

    Set objFeuille = ActiveSheet

    'parcour la collection de Shape pour les supprimer sauf celui dont le nom
    'est explicitement inscrit
    For Each Sh In objFeuille.Shapes

        If Sh.Name <> "NomDuBouton" Then Sh.Delete

    Next Sh

    Set objPict = objFeuille.Pictures.Insert(Range("P43") & "\admin" & Worksheets("Newfacture").Range("N41").Value & ".jpg")

    With objPict

        .Left = Range("E43").Left
        .Top = Range("E43").Top
        .Width = Range("E43").Width
        .Height = Range("E43").Height

    End With

End Sub

Hervé.

Le 05/10/2013 à 13:58

Merci beaucoup cela marche très bien,

Seul hic (mais qui n'est pas très important car ça marche)je n'ai pas pu simplifier la formule car sinon quand il n'y a pas d'image ça bug,

Et j'ai aussi sur une 2iem condition pour un autre emplacement et je n'ai pas réussi a le faire avec formule simplifier.

Par contre si j'ai d'autre image par la suite que je ne veux pas supprimer, je peux simplement rajouter cette ligne comme ci dessous ou faut t,il faire autrement.

Mon code complet

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = 0

Rows("45:101").EntireRow.Hidden = False
If Range("AE29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True
Application.ScreenUpdating = -1

Set objFeuille = ActiveSheet

    'parcour la collection de Shape pour les supprimer sauf celui dont le nom
   'est explicitement inscrit
   For Each Sh In objFeuille.Shapes

        If Sh.Name <> "CommandButton1" Then Sh.Delete

    Next Sh

If Worksheets("Newfacture").Range("T41").Value = 1 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin1.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 2 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin2.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 3 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin3.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 4 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin4.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 5 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin5.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 6 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin6.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 7 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin7.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 8 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin8.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 9 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin9.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("T41").Value = 10 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin10.jpg")
With objPict
.Left = Range("H43").Left
.Top = Range("H43").Top
.Width = Range("H43").Width
.Height = Range("H43").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 1 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin1.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 2 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin2.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 3 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin3.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 4 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin4.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 5 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin5.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 6 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin6.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 7 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin7.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 8 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin8.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 9 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin9.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If
If Worksheets("Newfacture").Range("U41").Value = 10 Then
Set objFeuille = ActiveSheet
Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin10.jpg")
With objPict
.Left = Range("H87").Left
.Top = Range("H87").Top
.Width = Range("H87").Width
.Height = Range("H87").Height
End With
End If

End Sub

si je modifie comme ceci?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = 0

Rows("45:101").EntireRow.Hidden = False
If Range("AE29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True
Application.ScreenUpdating = -1

Set objFeuille = ActiveSheet

    'parcour la collection de Shape pour les supprimer sauf celui dont le nom
   'est explicitement inscrit
   For Each Sh In objFeuille.Shapes

        If Sh.Name <> "CommandButton1" Then Sh.Delete
        If Sh.Name <> "Nom de nouvelle image" Then Sh.Delete

    Next Sh

et la suite comme ci dessus es ce que cela va fonctionner?

Encore merci beaucoup

Le 06/10/2013 à 09:25

Bonjour,

Seul hic (mais qui n'est pas très important car ça marche)je n'ai pas pu simplifier la formule car sinon quand il n'y a pas d'image ça bug,

Il n'y a aucune raison que ça ne fonctionne pas en construisant le chemin avec la valeur de T41 et U41. Ton code devrais resembler a celui qui est ci-dessous.

Les deux conditions doivent être dans le même test car le compilateur exécute les lignes de code de haut en bas et si, par exemple, le nom du shape est "Nom de nouvelle image" quand il compare à "CommandButton1" et bien il sera supprimer !

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim CheminImg As String

    Application.ScreenUpdating = 0

    Rows("45:101").EntireRow.Hidden = False

    If Range("AE29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True

    Application.ScreenUpdating = -1

    'parcours la collection de Shapes pour les supprimer sauf celui dont le nom
    'est explicitement inscrit
    'Les deux conditions doivent être dans le même test car le compilateur
    'exécute les lignes de code de haut en bas et si le nom du shape
    'est "Nom de nouvelle image" quand il compare à "CommandButton1" et bien
    'il sera supprimer !
    For Each Sh In objFeuille.Shapes

         If Sh.Name <> "CommandButton1" Or Sh.Name <> "Nom de nouvelle image" Then Sh.Delete

     Next Sh

    CheminImg = Range("V43").Value & "\admin" & Worksheets("Newfacture").Range("T41").Value & ".jpg"

    Set objPict = ActiveSheet.Pictures.Insert(CheminImg)

    With objPict

        .Left = Range("H43").Left
        .Top = Range("H43").Top
        .Width = Range("H43").Width
        .Height = Range("H43").Height

    End With

    CheminImg = Range("V43") & "\admin" & Worksheets("Newfacture").Range("U41").Value & ".jpg"

    Set objPict = ActiveSheet.Pictures.Insert(CheminImg)

    With objPict

        .Left = Range("H87").Left
        .Top = Range("H87").Top
        .Width = Range("H87").Width
        .Height = Range("H87").Height

    End With

End Sub

Hervé.

Bonjour,

Seul hic (mais qui n'est pas très important car ça marche)je n'ai pas pu simplifier la formule car sinon quand il n'y a pas d'image ça bug,

Il n'y a aucune raison que ça ne fonctionne pas en construisant le chemin avec la valeur de T41 et U41. Ton code devrais resembler a celui qui est ci-dessous.

Les deux conditions doivent être dans le même test car le compilateur exécute les lignes de code de haut en bas et si, par exemple, le nom du shape est "Nom de nouvelle image" quand il compare à "CommandButton1" et bien il sera supprimer !

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim CheminImg As String

    Application.ScreenUpdating = 0

    Rows("45:101").EntireRow.Hidden = False

    If Range("AE29").Value = "Masquer" Then Rows("45:88").EntireRow.Hidden = True

    Application.ScreenUpdating = -1

    'parcours la collection de Shapes pour les supprimer sauf celui dont le nom
    'est explicitement inscrit
    'Les deux conditions doivent être dans le même test car le compilateur
    'exécute les lignes de code de haut en bas et si le nom du shape
    'est "Nom de nouvelle image" quand il compare à "CommandButton1" et bien
    'il sera supprimer !
    For Each Sh In objFeuille.Shapes

         If Sh.Name <> "CommandButton1" Or Sh.Name <> "Nom de nouvelle image" Then Sh.Delete

     Next Sh

    CheminImg = Range("V43").Value & "\admin" & Worksheets("Newfacture").Range("T41").Value & ".jpg"

    Set objPict = ActiveSheet.Pictures.Insert(CheminImg)

    With objPict

        .Left = Range("H43").Left
        .Top = Range("H43").Top
        .Width = Range("H43").Width
        .Height = Range("H43").Height

    End With

    CheminImg = Range("V43") & "\admin" & Worksheets("Newfacture").Range("U41").Value & ".jpg"

    Set objPict = ActiveSheet.Pictures.Insert(CheminImg)

    With objPict

        .Left = Range("H87").Left
        .Top = Range("H87").Top
        .Width = Range("H87").Width
        .Height = Range("H87").Height

    End With

End Sub

Hervé.

Le 06/10/2013 à 10:45

super merci comme ceci ça marche super.

je sais plus comment j'avais essayer mais c'était à peu près ça mais cela ne marchais pas.

bon dimanche

Rechercher des sujets similaires à "probleme bouton activex"