XL 2010 Imprimer une liste déroulante

[Slip_Officiel]

Bonjour à tous,

Malgré beaucoup de recherche, je n'ai pas trouvé de solution à mon problème. Un poste de ce forum ressemble de très près à ce que je recherche mais rien ne fonctionne.

Je m'explique :

Tout d'abord j'utilise excel 2010.
Je souhaiterais créer un bouton ou simplement exécuter un code VBA pour imprimer plusieurs feuille qui dépende d'une liste déroulante.
Je précise : Dans ma case "A1"j'ai créer une liste déroulante (via validation des données -> Liste), et suivante la valeur de la liste sélectionnée, un graphique s'affiche en conséquence. Donc sur la même feuille, plusieurs graphiques différents peuvent apparaitre.
J'aimerais donc imprimer la feuille avec toutes les valeurs de la liste possible(donc autant d'impression qu'il y a de valeurs dans la liste), l'opération est laborieuse si je le fais à la main car la liste est longue et je suis amené à le faire dans plusieurs classeurs. Il serait donc judicieux de créer un code qui me permettrai de le faire automatiquement.

Si quelqu'un peut m'aider SVP, je vous en serai très reconnaissant.

Merci d'avance

 

[mapomme]

Bonsoir @Slip_Officiel,

Voir dans le fichier joint. Le code est dans Module1. Cliquer sur le bouton noir. Pour les tests, on n'imprime pas mais on affiche l'aperçu.:

Sub Test()
Dim sep, maListe, valeurInit, valeur
  Application.ScreenUpdating = False
  sep = Application.DecimalSeparator
  If sep = "." Then sep = "," Else sep = ";"
  Worksheets("FeuilleListeA1").Activate
  maListe = ListeValid(Range("a1"))
  valeurInit = Range("a1").Value
  For Each valeur In Split(maListe, sep)
    Range("a1") = valeur
    ActiveSheet.PrintPreview    '(utiliser PrintOut pour imprimer)
  Next valeur
  Range("a1") = valeurInit
End Sub

Function ListeValid(xcell)
' retourne une liste contenant les valeurs de la liste de validation de xcell
' les élément de cette liste sont séparés par le caractère sep
Dim x, i&, t, sep, elem, s

  sep = Application.DecimalSeparator
  If sep = "." Then sep = "," Else sep = ";"
  With xcell.Validation
    x = .Formula1
    If Left(x, 1) = "=" Then
      t = Range(Mid(x, 2, 255)).Value
      If Not IsArray(t) Then
        ListeValid = t
      Else
        For Each elem In t: s = s & sep & elem: Next elem
        ListeValid = Mid(s, 2)
      End If
    Else
      ListeValid = x
    End If
  End With
End Function

 

[Slip_Officiel]

Bonjour @mapomme ,

Tout marche à merveille, je te remercie !!
En espérant que ce poste servira a quelqu'un d'autre !

Cependant je n'ai pas très bien compris la deuxième partie du code, si quelqu'un a un moment pour le détailler je suis preneur.

Merci Encore

 

[mapomme]

Bonsoir @Slip_Officiel

Voir dans le fichier le code qui a été commenté.