AIDE MODIF MACRO
Gwen59000
Messages postés
52
Statut
Membre
-
tompols Messages postés 1273 Date d'inscription Statut Contributeur Dernière intervention -
tompols Messages postés 1273 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je dispose de la macro suivante pour créer un fichier par client à partir d'une liste. Il crée ce fichier uniquement s'il n'est pas déjà exisant. Cela peut paraitre inutile mais je voudrais que si le fichier existe déjà il soit ouvert, enregistré et fermé :
Sub crea_fichierstransport()
Set fso = CreateObject("Scripting.FileSystemObject")
For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\" & CStr(c.Value) & ".xls"
If Not fso.FileExists(ficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\Modèle.xls", ficdest
Workbooks.Open ficdest
Sheets("STATS").Range("B1").Value = c.Value
Sheets("GRAPHIQUES").Range("A1").Value = c.Value
Sheets("NOTES").Range("B1").Value = c.Value
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Next c
End Sub
merci d'avance,
Gwénaël
Je dispose de la macro suivante pour créer un fichier par client à partir d'une liste. Il crée ce fichier uniquement s'il n'est pas déjà exisant. Cela peut paraitre inutile mais je voudrais que si le fichier existe déjà il soit ouvert, enregistré et fermé :
Sub crea_fichierstransport()
Set fso = CreateObject("Scripting.FileSystemObject")
For Each c In Sheets(2).Range("C3:C1001")
If Not IsEmpty(c) Then
ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\" & CStr(c.Value) & ".xls"
If Not fso.FileExists(ficdest) Then
fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\Modèle.xls", ficdest
Workbooks.Open ficdest
Sheets("STATS").Range("B1").Value = c.Value
Sheets("GRAPHIQUES").Range("A1").Value = c.Value
Sheets("NOTES").Range("B1").Value = c.Value
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Next c
End Sub
merci d'avance,
Gwénaël
2 réponses
-
Voilà je te propose ce code dont tu pourras t'inspirer.
il te suffira de faire appel à la fonction dans ta boucle
Sub test()
chemin = "C:\DATA\"
fichier = "Essai1.xls"
If isFileExist(chemin + fichier) Then
'existe
Else
'n'existe pas
End If
End Sub
Function isFileExist(filename As String)
Dim NumFichier As Integer, Errnum As Integer
Err.Clear
On Error Resume Next
NumFichier = FreeFile()
Open filename For Input Lock Read As #NumFichier
Close NumFichier
Errnum = Err
On Error GoTo 0
Select Case Errnum
Case 0
isFileExist = True
Case 53
isFileExist = False
End Select
End Function -
Salut,
Bon jvois pas bien l'interet de ce que tu demandes mais voilà :Sub crea_fichierstransport() Set fso = CreateObject("Scripting.FileSystemObject") For Each c In Sheets(2).Range("C3:C1001") If Not IsEmpty(c) Then ficdest = "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\" & CStr(c.Value) & ".xls" If fso.FileExists(ficdest) Then Set cl = Workbooks.Open(ficdest) cl.Save cl.Close Else fso.CopyFile "\\Serveur3\dserveur\Récapitulatif Clients Lesquin\Clients\Clients Transport\Modèle.xls", ficdest Workbooks.Open ficdest Sheets("STATS").Range("B1").Value = c.Value Sheets("GRAPHIQUES").Range("A1").Value = c.Value Sheets("NOTES").Range("B1").Value = c.Value ActiveWorkbook.Save ActiveWorkbook.Close End If End If Next c End Sub
