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
A voir également:
- AIDE MODIF MACRO
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Macro maker - Télécharger - Divers Utilitaires
- Actiona macro - Télécharger - Divers Utilitaires
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
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à :
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
