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
| Option Explicit ' Exige la déclaration explicite des variables
Public Nom As String
Public Fic_Dili As String
Public Num_Dos As String 'Chaine car je ne sais pas si cest du numérique ou pas
Public Lign As Long ' Variable permettant de changer de ligne
Public Const Chem = "L:\Travail\_developpez\ExcelLiod\"
'************************************************************
' Macro Creat_Dili
' Macro créant des fichiers Diligences a base du modèle joint
'************************************************************
Sub Creat_Dili()
On Error Resume Next
Lign = 2 ' on commence sur la ligne 2
' afficher la feuille qui contients les noms
Sheets("Feuil1").Select
Do 'Boucle pour passer en revu tous les noms
' On test si le fichier est clos. UCase permet de
' transformer les minuscules en majuscules
If UCase(Cells(Lign, 3).Value) <> "X" Then
'On recupères les valeurs pour les copier dans le modèle
Nom = Cells(Lign, 2).Value
Fic_Dili = Chem & Cells(Lign, 4).Value
Num_Dos = Cells(Lign, 1).Value
Sheets("Modele").Select
Cells(2, 2).Value = Nom
Cells(3, 2).Value = Num_Dos
' On copie la feuille
Sheets("Modele").Copy
' on copie ds un classeur de format 2003
ActiveWorkbook.SaveAs Filename:=Fic_Dili, FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'on ferme le nouveau classeur
ActiveWindow.Close
End If
Lign = Lign + 1
Sheets("Feuil1").Select
Loop While Cells(Lign, 1).Value <> ""
'Pour faire propre on peut effacer ce que contient la feuille modele (facultatif)
Cells(2, 2).Value = ""
Cells(3, 2).Value = ""
End Sub
'************************************************************
' Macro Creat_Dili version fichier 2007
' Macro créant des fichiers Diligences a base du modèle joint
'************************************************************
Sub Creat_Dili_2007()
On Error Resume Next
Lign = 2 ' on commence sur la ligne 2
' afficher la feuille qui contients les noms
Sheets("Feuil1").Select
Do 'Boucle pour passer en revu tous les noms
' On test si le fichier est clos. UCase permet de
' transformer les minuscules en majuscules
If UCase(Cells(Lign, 3).Value) <> "X" Then
'On recupères les valeurs pour les copier dans le modèle
Nom = Cells(Lign, 2).Value
Fic_Dili = Chem & Cells(Lign, 4).Value & "x"
Num_Dos = Cells(Lign, 1).Value
Sheets("Modele").Select
Cells(2, 2).Value = Nom
Cells(3, 2).Value = Num_Dos
' On copie la feuille
Sheets("Modele").Copy
' on copie ds un classeur de format 2003
ActiveWorkbook.SaveAs Filename:=Fic_Dili, FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
'on ferme le nouveau classeur
ActiveWindow.Close
End If
Lign = Lign + 1
Sheets("Feuil1").Select
Loop While Cells(Lign, 1).Value <> ""
'Pour faire propre on peut effacer ce que contient la feuille modele (facultatif)
Cells(2, 2).Value = ""
Cells(3, 2).Value = ""
End Sub |
Partager