AIDE MODIF MACRO

Fermé

Gwen59000 Messages postés 51 Date d'inscription mardi 29 décembre 2009 Statut Membre Dernière intervention 19 avril 2010 - 19 avril 2010 à 17:24
tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 - 20 avril 2010 à 10:27

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

A voir également:

AIDE MODIF MACRO
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro recorder - Télécharger - Confidentialité
Macro souris ✓ - Forum Windows

2 réponses

Réponse 1 / 2

Bidouilleu_R Messages postés 1181 Date d'inscription mardi 27 mai 2008 Statut Membre Dernière intervention 12 juillet 2012 289
20 avril 2010 à 10:03

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

Réponse 2 / 2

tompols Messages postés 1273 Date d'inscription jeudi 29 juillet 2004 Statut Contributeur Dernière intervention 25 novembre 2013 435
20 avril 2010 à 10:27

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

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Copie automatique tableau Excel sans macro

recup couleur de cellule sans macro

Lien de téléchargement de nbLettre.xla

tri automatque sur excel sans créer de macro

Discussions similaires

Newsletters