Re : Afficher une image en fonction du contenu de la cellule
Wilfried,
Je ne peux pas vraiment adapter ta macro à la mienne car la macro source est complexe (cf. ci-dessous) : elle filtre et extrait des données de plusieurs classeurs, qui sont copiées dans un modèle de doc ("VOTREARMOIRE").
Elle est un peu indigeste 😛 mais tu trouveras en gras ce que j'ai rajouté pour copier mes colonnes contenant les picto... et le résultat sur le fichier ci-joint.
Je ne sais pas trop comment faire, j'ai l'impression que c'est lors de l'extraction que ça beugue... Je pensais à essayer d'extraire seulement les croix et mettre une macro dans la feuille de destination pour que quand elle repère une "x", l'image soit automatiquement insérée (cad adapter ta macro).
Qu'en penses-tu ?
' Mis à jour le 05/09/2007
Const Bas_Tablo = 363 'indice dernière ligne STOCKMAX : A EVENTUELLEMENT ACTUALISER !!!
Public Date_Maj As String
Public Nom_Corr As String
Public Nom_Gest As String
Public Nom_Service As String
Public Nom_UE As String
Public VArmoire As String
Private Sub Commandbutton1_Click()
' Gestionnaire d'erreurs
On Error GoTo DesErreurs
' Mémorise le choix d'armoire PC
VArmoire = UserForm1.ComboBox1
' Cherche la colonne de l'APC choisie
i = 29 'indice "0" des colonnes armoires : A EVENTUELLEMENT ACTUALISER !!!
Do
i = i + 1
Loop Until Cells(10, i) = VArmoire
' Sélectionne la feuille STOCKMAX et filtre la colonne APC (choisie dans le combo) avec valeurs <> 0
Worksheets("STOCKMAX").Range(Cells(12, i).Address & ":" & Cells(Bas_Tablo, i).Address).AutoFilter _
Field:=i, Criteria1:="<>"
' Efface données de VOTREARMOIRE et copie les nouvelles de STOCKMAX vers VOTREARMOIRE
Worksheets("VOTREARMOIRE").Range("A7:F11").ClearContents
Worksheets("VOTREARMOIRE").Range("A16:W" & Bas_Tablo).ClearContents
Worksheets("STOCKMAX").Range("B12:E" & Bas_Tablo).Copy
Worksheets("VOTREARMOIRE").Paste Destination:=Worksheets("VOTREARMOIRE").Range("A16")
Worksheets("STOCKMAX").Range("H12:H" & Bas_Tablo).Copy
Worksheets("VOTREARMOIRE").Paste Destination:=Worksheets("VOTREARMOIRE").Range("W16")
Worksheets("STOCKMAX").Range(Cells(12, i).Address & ":" & Cells(Bas_Tablo, i).Address).Copy
Worksheets("VOTREARMOIRE").Paste Destination:=Worksheets("VOTREARMOIRE").Range("V16")
Worksheets("STOCKMAX").Range("I12:R" & Bas_Tablo).Copy
Worksheets("VOTREARMOIRE").Paste Destination:=Worksheets("VOTREARMOIRE").Range("E16")
Worksheets("STOCKMAX").Range("T12:AA" & Bas_Tablo).Copy
Worksheets("VOTREARMOIRE").Paste Destination:=Worksheets("VOTREARMOIRE").Range("N16")
' Cherche les infos l'amoire dans la feuille Armoires
Sheets("Armoires").Select
w = 1
While Cells(w, 1).Value <> ""
If Cells(w, 1).Value = VArmoire Then
Activité = Cells(w, 2).Value
Info_Compl = Cells(w, 3).Value
Nom_Corr = Cells(w, 4).Value
Nom_Gest = Cells(w, 5).Value
Date_Maj = Cells(w, 6).Value
Commentaire = Cells(w, 7).Value
End If
w = w + 1
Wend
' Ferme le userform
UserForm1.Hide
' Selection de VOTRE ARMOIRE et ajout des infos en entête
Worksheets("VOTREARMOIRE").Select
Worksheets("VOTREARMOIRE").Cells(3, 23).Value = Date_Maj
Worksheets("VOTREARMOIRE").Cells(5, 4).Value = "" & VArmoire
Worksheets("VOTREARMOIRE").Cells(7, 1).Value = "Activité"
Worksheets("VOTREARMOIRE").Cells(7, 4).Value = Activité
Worksheets("VOTREARMOIRE").Cells(8, 4).Value = Info_Compl
Worksheets("VOTREARMOIRE").Cells(9, 4).Value = Commentaire
Worksheets("VOTREARMOIRE").Cells(10, 1).Value = "Correspondant(e)"
Worksheets("VOTREARMOIRE").Cells(10, 4).Value = Nom_Corr
Worksheets("VOTREARMOIRE").Cells(11, 1).Value = "Gestionnaire(s)"
Worksheets("VOTREARMOIRE").Cells(11, 4).Value = Nom_Gest
i = 16
Do
i = i + 1
Loop Until Cells(i, 4) = ""
Worksheets("VOTREARMOIRE").PageSetup.PrintArea = Cells(1, 1).Address & ":" & Cells((i - 1), 23).Address
' Lance la page en printpreview
Worksheets("VOTREARMOIRE").PrintPreview
Exit Sub
DesErreurs:
If Err.Number = 91 Then
Date_Maj = Cells(5, 6).Value
Resume Next
End If
End Sub
Private Sub userform_activate()
' Gestionnaire d'erreurs
On Error GoTo DesErreurs
' Efface le combo et charge les infos dedans
UserForm1.ComboBox1.Clear
UserForm1.ComboBox1.AddItem "APC 1"
UserForm1.ComboBox1.AddItem "APC 2"
UserForm1.ComboBox1.AddItem "APC 3"
UserForm1.ComboBox1.AddItem "APC 4"
UserForm1.ComboBox1.AddItem "APC 5"
UserForm1.ComboBox1.AddItem "APC 6"
UserForm1.ComboBox1.AddItem "Bac C"
UserForm1.ComboBox1.AddItem "Bac D"
UserForm1.ComboBox1.AddItem "APC 7"
UserForm1.ComboBox1.AddItem "Frigo plasturgie"
UserForm1.ComboBox1.AddItem "APC 8"
UserForm1.ComboBox1.AddItem "APC 9"
UserForm1.ComboBox1.AddItem "APC 10"
UserForm1.ComboBox1.AddItem "APC 11"
UserForm1.ComboBox1.AddItem "APC 12"
UserForm1.ComboBox1.AddItem "APC 13"
UserForm1.ComboBox1.AddItem "APC 14"
UserForm1.ComboBox1.AddItem "APC 15"
UserForm1.ComboBox1.AddItem "Bac E"
UserForm1.ComboBox1.AddItem "APC 16"
UserForm1.ComboBox1.AddItem "APC 17"
UserForm1.ComboBox1.AddItem "APC 18"
UserForm1.ComboBox1.AddItem "Bac dégraisseur"
UserForm1.ComboBox1.AddItem "Bac A"
UserForm1.ComboBox1.AddItem "Bac B"
UserForm1.ComboBox1.AddItem "Soute peinture"
UserForm1.ComboBox1.AddItem "APC 19"
UserForm1.ComboBox1.AddItem "APC 20"
UserForm1.ComboBox1.AddItem "Local produits d'entretien"
' Selectionne STOCKMAX et supprime les filtres
Worksheets("STOCKMAX").Select
Worksheets("STOCKMAX").ShowAllData
Exit Sub
DesErreurs:
If Error = "La méthode ShowAllData de la classe Worksheet a échoué." Then
Resume Next
End If
End Sub