1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
| Sub CréationPublishers()
' declaration des variables
Dim i, debut, fin As Integer
Dim sh As String
Dim titre, dates, produit, code, libelle, euro, cent, franc, unite As String
' debut de boucle
Range("G11").Select
debut = ActiveCell.Value
Range("G13").Select
fin = ActiveCell.Value
i = debut
While i <= fin
' debut de procedure
sh = "n°" & i
Sheets("listing").Select
ActiveSheet.Unprotect
If Range("L" & (i + 1)).Value = "Oui" Then
' Sheets(sh).Activate
' ActiveWindow.SelectedSheets.Delete
Else
End If
' copie matrice et renomme suivant i
Sheets("matrice").Select
If i = 1 Then
Sheets("matrice").Copy After:=Sheets("listing")
Sheets("matrice (2)").Select
Sheets("matrice (2)").Name = sh
Else
Sheets("matrice").Copy After:=Sheets("listing")
Sheets("matrice (2)").Select
Sheets("matrice (2)").Name = sh
End If
' changement texte suivant listing
Sheets("listing").Select
Range("B" & (i + 1)).Select
titre = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Unprotect
ActiveSheet.Shapes("WordArt 1").Select
Selection.ShapeRange.TextEffect.Text = titre
Sheets("listing").Select
Range("C" & (i + 1)).Select
dates = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 2").Select
Selection.ShapeRange.TextEffect.Text = dates
Sheets("listing").Select
Range("D" & (i + 1)).Select
produit = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 3").Select
Selection.ShapeRange.TextEffect.Text = produit
Sheets("listing").Select
Range("E" & (i + 1)).Select
code = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 9").Select
Selection.ShapeRange.TextEffect.Text = code
Sheets("listing").Select
Range("F" & (i + 1)).Select
libelle = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 4").Select
Selection.ShapeRange.TextEffect.Text = libelle
Sheets("listing").Select
Range("H" & (i + 1)).Select
euro = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 5").Select
Selection.ShapeRange.TextEffect.Text = euro
Sheets("listing").Select
Range("I" & (i + 1)).Select
cent = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 6").Select
Selection.ShapeRange.TextEffect.Text = cent
Sheets("listing").Select
Range("J" & (i + 1)).Select
franc = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 8").Select
Selection.ShapeRange.TextEffect.Text = franc
Sheets("listing").Select
Range("K" & (i + 1)).Select
unite = ActiveCell.Value
Sheets(sh).Select
ActiveSheet.Shapes("WordArt 27").Select
Selection.ShapeRange.TextEffect.Text = unite
' Protège le publisher
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("listing").Select
Range("L" & (i + 1)).Value = "Oui"
' FIN changement texte suivant listing
i = i + 1
Wend
'Protège la feuille de données
Sheets("listing").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' FIN de boucle
End Sub
' FIN de procedure |
Partager