Générer un catalogue de fiche produit à partir d'une liste

[pierre93]

Bonjour à tous,

Me revoilà avec de nouvelles questions !
En effet, mes besoins étant sans cesse affinés, j'ai complété plusieurs macros que l'on m'avait donné ou que j'ai trouvé pour faire quelque chose de sympa. Mais je suis un peu bloqué maintenant, vous verrez dans le fichier un classeur avec deux feuilles. Sur la première une liste et sur la deuxième une fiche produit. Les macro actuelles permettent de remplir la fiche selon certains critères, de l'effacer, de l'enregistrer en PDF et de l'envoyer par mail. Mais ces différentes macros ne génèrent qu'une fiche. Ce que je souhaiterais faire est de rajouter une nouvelle macro qui génère une fiche par ligne de produit se trouvant dans la première feuille, je souhaiterais que ces fiches produits apparaissent les une sous les autres dans la 2eme feuille (ou dans une 3eme mais dans tous les cas toutes sur la même feuille), je pense qu'il y a une histoire de boucle et autre mais je n'ai pas trouvé de fichier de base sur lequel m'appuyer, Peut être pourrez-vous m'aider !
Merci d'avance.

 

[pierre93]

Re : Générer un catalogue de fiche produit à partir d'une liste

Rebonjour à tous,

J'ai un peu avancé, mais pas trop !
Alors j'arrive à générer 10 feuilles de fiches produits mais trois problèmes restent à régler :
1 : Je n'arrive pas à renommer les feuilles créées automatiquement, quelque chose m'échappe. (voir macro, la ligne posant problème est mise en commentaire, j'aimerais que les onglets soient renommés avec la colonne "O")
2 : La formule ne créée que 10 nouvelles feuilles, et là je n'ai vraiment aucune idée de la raison
3 : Dans l'absolu je ne veux pas créer une fiche produit par feuille mais mettre toutes les fiches produit à la suite dans la même feuille.

Merci de votre aide !

Edit : Bon le problème deux n'est plus, j'ai légèrement modifié ma ligne et ca passe tout seul maintenant. Idem pour le problème 1. Reste le problème 3 le plus gros !

Par souci de place ce deuxième zip ne contient aucune photo (et j'atteins déjà 48,7ko, une ligne de code de plus et je peux plus poster mon fichier ! :

 

[pierre93]

Re : Générer un catalogue de fiche produit à partir d'une liste

Bon je vois que ma question n'a pas soulevé les foules !!!
J'ai trouvé une solution qui fonctionne (c'est le principal mais qui est loin d'être optimisé!)
Je m'explique ma macro va d'abord chercher chaque ligne de la 1ere feuille, puis se sert de la feuille "modèle" pour créer la fiche produit dans une nouvelle feuille. Une fois la fiche créée, la macro copie cette fiche dans la feuille catalogue, puis supprime la feuille de la fiche produit, puis la macro fait de même avec chaque ligne de la première feuille et termine par réajuster les colonnes pour garde la mise en forme souhaitée. Oui, c'est un peu compliqué mais il est souvent plus simple de faire compliqué !
Voici donc le code :

Sub catalogue()

' déclaration des variables
Dim numligne As Long, Compteur As Integer, Nom As String
' traitement
For numligne = 2 To 65536
If Sheets("Base_CSA_CDT").Range("A" & numligne) = blank Then Exit For ' si la cellule est vide sortie de boucle
Sheets("modele").Copy After:=Sheets(Sheets.Count) ' copie la feuille modele
With Sheets(Sheets.Count) ' remplir les cases
.Range("B1:H1") = Sheets("Base_CSA_CDT").Range("B" & numligne)
.Range("B22") = Sheets("Base_CSA_CDT").Range("Q" & numligne)
.Range("F2:H2") = Sheets("Base_CSA_CDT").Range("P" & numligne)
.Range("B3:C3") = Sheets("Base_CSA_CDT").Range("Z" & numligne)
.Range("B4:H4") = Sheets("Base_CSA_CDT").Range("R" & numligne)
.Range("B5:H5") = Sheets("Base_CSA_CDT").Range("I" & numligne)
.Range("B6:H6") = Sheets("Base_CSA_CDT").Range("M" & numligne)
.Range("B7") = Sheets("Base_CSA_CDT").Range("AA" & numligne)
.Range("D7") = Sheets("Base_CSA_CDT").Range("F" & numligne)
.Range("F7") = Sheets("Base_CSA_CDT").Range("G" & numligne)
.Range("H7") = Sheets("Base_CSA_CDT").Range("H" & numligne)
.Range("B8:H8") = Sheets("Base_CSA_CDT").Range("J" & numligne)
.Range("B9:H9") = Sheets("Base_CSA_CDT").Range("K" & numligne)
.Range("B10:H10") = Sheets("Base_CSA_CDT").Range("L" & numligne)
If Sheets("Base_CSA_CDT").Range("X" & numligne) = blank Then
.Range("B11:B12") = Sheets("Base_CSA_CDT").Range("W" & numligne) & "/" & Sheets("Base_CSA_CDT").Range("Y" & numligne)
Else
.Range("B11:B12") = Sheets("Base_CSA_CDT").Range("X" & numligne) & "/" & Sheets("Base_CSA_CDT").Range("Y" & numligne)
End If
.Range("C12") = Sheets("Base_CSA_CDT").Range("AC" & numligne)
.Range("D12") = Sheets("Base_CSA_CDT").Range("AB" & numligne)
.Range("E12") = Sheets("Base_CSA_CDT").Range("AD" & numligne)
.Range("F12") = Sheets("Base_CSA_CDT").Range("S" & numligne)
If Sheets("Base_CSA_CDT").Range("AK" & numligne) = "G" Then
.Range("G12:H12") = Sheets("Base_CSA_CDT").Range("AG" & numligne)
Else
.Range("G12:H12") = Sheets("Base_CSA_CDT").Range("AF" & numligne)
End If
.Range("B13:C13") = Sheets("Base_CSA_CDT").Range("AH" & numligne)
.Range("E13:H13") = Sheets("Base_CSA_CDT").Range("AJ" & numligne)
.Range("B14:H14") = Sheets("Base_CSA_CDT").Range("AM" & numligne)
.Range("B15") = Sheets("Base_CSA_CDT").Range("O" & numligne)
.Range("E15:H15") = Sheets("Base_CSA_CDT").Range("E" & numligne)
If Sheets("Base_CSA_CDT").Range("U" & numligne) = "DEPOSABLE" Then
.Range("B16") = "DEP."
Else
.Range("B16") = "NON"
End If
If .Range("B16") = "NON" Then
.Range("B16").Font.ColorIndex = 3
Else
.Range("B16").Font.ColorIndex = 0
End If
.Range("B18:H18").Activate
ImpImage (Sheets("Base_CSA_CDT").Range("O" & numligne).Text)
ActiveSheet.Name = ActiveSheet.Range("B15").Value

Rows("1:18").Select
Selection.Copy
Sheets("catalogue").Activate
Range("A65536").End(xlUp).Offset(2, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Application.DisplayAlerts = False
For Compteur = Worksheets.Count To 1 Step -1
Nom = Sheets(Compteur).Name
Select Case Nom
Case "Base_CSA_CDT", "Fiche_produit", "Modele", "Catalogue"
Case Else
Sheets(Compteur).Delete
End Select
Next Compteur
End With

Next numligne
Sheets("catalogue").Columns("A:A").EntireColumn.AutoFit
Sheets("catalogue").Columns("D").EntireColumn.AutoFit


End Sub

Ouf, c'est terminé !