Probleme liste deroulante

Le 11/10/2013 à 11:47

Bonjour,

J'ai un petit problème avec mes liste déroulante, elle disparaisse a chaque fois que je fais une opération, je dois enregistrer et la elle réapparaisse,

Je pense que cela vient de cette macro,

Comment faire.

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

Merci de votre aide

Le 11/10/2013 à 12:02

Bonjour,

Pourquoi cette macro a-t-elle besoin d'être gérée par une procédure événementielles (Worksheet_Change).

Une macro dans un module standard devrait être suffisant. Il n'est utile de tout refaire à chaque modification apportée dans la feuille de calcul.

Ta macro ne fait pas référence à des listes déroulantes. Je suppose donc qu'elles se trouvent dans les lignes que tu masques 

Rows("45:88").EntireRow.Hidden = True

Cdlt

Le 11/10/2013 à 12:03

Bonjour

Bonjour Jean-Eric

A 1ère vue pas de relation de cause à effet

Ton fichier serait utile

En attendant essayes cette simplification (non testée)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

  Application.ScreenUpdating = False

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

  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

  With Sheets("Newfacture").Range("T41")
    If .Value > 0 And .Value < 11 Then
      Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin" & .Value & ".jpg")
      With objPict
        .Left = Range("H43").Left
        .Top = Range("H43").Top
        .Width = Range("H43").Width
        .Height = Range("H43").Height
      End With
    End If
  End With

  With Sheets("Newfacture").Range("U41")
    If .Value > 0 And .Value < 11 Then
      Set objPict = objFeuille.Pictures.Insert(Range("V43") & "\admin" & .Value & ".jpg")
      With objPict
        .Left = Range("H87").Left
        .Top = Range("H87").Top
        .Width = Range("H87").Width
        .Height = Range("H87").Height
      End With
    End If
  End With
End Sub
Le 11/10/2013 à 13:16

Bonjour Banzai et Jean Eric,

La formule simplifier fonctionne très bien merci, mais ne resou pas mon problème.

Je vous envoie mon fichier,

Ps la mise en page n'est pas encore fini.

merci

19fichier.xlsm (161.79 Ko)
Le 13/10/2013 à 13:53

Bonjour

Remplaces dans la macro la partie correspondante

  ' parcour la collection de Shape pour les supprimer sauf celui dont le nom
  ' est explicitement inscrit
  For Each Sh In objFeuille.Shapes
    If Sh.Type <> msoFormControl Then
      If Sh.Name <> "CommandButton1" Then Sh.Delete
    End If
  Next Sh
Le 14/10/2013 à 05:40

merci beaucoup, sans vous je sais pas ce que je ferais, pas grand chose en réalité.

Rechercher des sujets similaires à "probleme liste deroulante"