Sub publipostage_DT_shoes()
'Macro crée par Loulou
Application.ScreenUpdating = False
Dim tab_publi, répertoire, frn, code_frn, ref, j
Dim nbre_ligne, nbre_ref_par_frn, nbre_frn, nbre_ligne_par_frn
Dim indice_ref, fihier_DT, FICHIER_INITIAL, couleur, ua, id, nom_onglet, chemin_image
Dim l, k, m As Integer
nbre_ligne = Range("I9999").End(xlUp).Row
Fichier_DT = "C:\Publipostage DT Shoes\DT Shoes - other style.xlsm"
On Error Resume Next
For j = 4 To nbre_ligne
Windows("Tableau publi DT shoes.xlsm").Activate
frn = Cells(j, 4)
ref = Cells(j, 8)
ua = Cells(j, 30)
chemin_image = Cells(2, 2)
'si nouveau fournisseur
If frn <> Cells(j - 1, 4).Value Then
nbre_ref = 1
nom_onglet = "PRODUIT"
répertoire = Cells(j, 1)
nbre_frn = nbre_frn + 1
Workbooks.Open Filename:= _
Fichier_DT
FICHIER_INITIAL = ActiveWorkbook.Name
Windows(FICHIER_INITIAL).Activate
Else
nbre_ref = nbre_ref + 1
End If
Windows("Tableau publi DT shoes.xlsm").Activate
'si nouvelle ref
If ref <> Cells(j + 1, 8) Then
'
'copie l'onglet PRODUCT SPEC et complète l'onglet
Windows(FICHIER_INITIAL).Activate
Sheets("PRODUIT").Copy After:=Sheets(nom_onglet)
ActiveSheet.Name = ref
nom_onglet = ref
Range("H7").Value = frn
Range("I15").Value = ua
Range("L15").Value = id
'insertion image produit
If ua <> "" Then
Windows(FICHIER_INITIAL).Activate
Range("F24:S37").Select
ActiveSheet.Pictures.Insert(chemin_image & "\" & ua & "G.JPG").Select
If Err <> 0 Then Err.Clear: GoTo saute
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 37.5
Selection.ShapeRange.IncrementTop 8.25
saute:
End If
End If
'Enregistre le fichier
Windows("Tableau publi DT shoes.xlsm").Activate
If frn <> Cells(j + 1, 4).Value Then
Windows(FICHIER_INITIAL).Activate
Sheets("PRODUIT").Select
ActiveWindow.SelectedSheets.Delete
Sheets("GENERAL").Select
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="" & répertoire & "\" & "TF Shoes - " & frn & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
FICHIER_INITIAL = ActiveWorkbook.Name
Application.DisplayAlerts = True
Windows(FICHIER_INITIAL).Activate
ActiveWorkbook.Close
End If
Next
Windows("Paramètres publi shoes.xlsx").Activate
ActiveWorkbook.Close
End Sub