Transformation macro Excel en macro word
Bonjour à toute l'équipe,
je voudrais avoir une macro que je lance a partir d'un classeur excel pour ouvrir un fichier word et ensuite creer un dossier(qui sera nommé grace au contenu des cellules A1 et A2) et enregistrer le fichier word (renomé lui aussi avec les cellules A1 et A2)dans ce dossier
je vous remercie tous pour votre aide precieuse
Bonjour,
Teste le code qui suit. Je suis partis du postulat que le nom du dossier est en A1 et le nom du fichier (sans extension .doc) est en A2, le dossier parent étant le dossier où se trouve le classeur :
Sub DossierWord()
Dim AppWord As Object
Dim Doc As Object
Dim Chemin As String
Dim Dossier As String
Dim Fichier As String
'nom du dossier en A1
Dossier = ActiveSheet.Range("A1").Value
'vérifie que l'anti slash est présent en fin de texte
If InStrRev(Dossier, "\") = 0 Then Dossier = Dossier & "\"
'nom du fichier en A2
Fichier = ActiveSheet.Range("A2").Value
'le dossier parent est le dossier du classeur
Chemin = ThisWorkbook.Path & "\" & Dossier
On Error Resume Next 'au cas où le dossier existe déjà
'création du dossier
MkDir Chemin
'supprime le gestionnaire
On Error GoTo 0
'création de l'application Word
Set AppWord = CreateObject("Word.Application")
With AppWord
.Visible = True 'rendue visible
Set Doc = .Documents.Add 'ajoute un document
Doc.SaveAs Chemin & Fichier 'et l'enregistre
End With
End Sub
Hervé.
Bonjour,
je te remercie vivement pour ton aide si precieuse.
A premiere vue cela fonctionne tres bien: creation du dossier et sauvegarde du fichier.
Maintenant i l me reste a l'adapter à tout le travail et je te tiendrai au courant en esperant ne pas avoir de probleme.
je te remercie encore une fois.
A+
Re-bonsoir,(Theze et/ou Hervé)
une premiere contrainte:
J'ai mes fichiers word types stockés dans un dossier ("Dossier_fichiers").
Serait-il possible d'avoir une liste box avec le nom des fichiers stockés dans ce dossier et ensuite choisir le fichier word à ouvrir.
ensuite creation du dossier nommé en A1 (ce qui est deja bon) et enregistrement sous (nom en A2) du fichier word ouvert.
Cordialement
Bonjour,
En tout premier, tu doit poser sur ta feuille une ListBox de type "Formulaire" que tu nomme "Zone de liste 1" si ce n'est pas le nom par défaut (voir la zone de nom à gauche de la barre de formule). Une fois ceci fait, tu exécute la proc "RemplirListeBox" en ayant au préalable adapter le chemin (ici, --> Chemin = ThisWorkbook.Path & "\Dossier_fichiers\") et l'extension (.doc,.docx,etc...). Quand la ListBox est remplie(La fonction "Fichiers" est appelée et elle retourne un tableau), un clic sur un élément de la liste va déclencher la proc "Ouvrir" avec en argument le chemin du dossier où se trouvent les fichiers listés puis, création du dossier, création de l'application Word, ouverture du fichier choisi et enregistrement sous...
Sub RemplirListeBox()
Dim S As Shape
Dim Tbl() As String
Dim I As Integer
Dim Chemin As String
Dim Ext As String
'adapter le nom de la ListBox dans la zone de nom d'Excel
'à gauche de la barre de formule (définir le nom puis appui sur "Entrée")
Set S = ActiveSheet.Shapes("Zone de liste 1")
'adapter le chemin
Chemin = ThisWorkbook.Path & "\Dossier_fichiers\"
'extension du type de fichiers
Ext = ".doc"
'définie la procédure appelée par la ListBox sur clic d'un élément
'en appelant la proc Ouvrir par la ListBox, on est sûr qu'un choix a été fait !
'le dossier pour l'ouverture du fichier est passé en argument
S.OnAction = "'Ouvrir """ & Chemin & "'"
'supprime les éléments de la liste avant remplissage
S.ControlFormat.RemoveAllItems
'récupère la liste des fichiers du dossier
Tbl() = Fichiers(Chemin, Ext)
'et les entre dans la ListBox
For I = 1 To UBound(Tbl)
S.ControlFormat.AddItem Tbl(I)
Next I
End Sub
Function Fichiers(Chemin As String, _
Extension As String) As String() 'la fonction retourne un tableau
Dim Tbl() As String
Dim Fich As String
Dim I As Integer
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'seuls les fichiers avec l'extension voulue
Fich = Dir(Chemin & "*" & Extension)
Do While (Len(Fich) > 0)
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fich
Fich = Dir()
Loop
Fichiers = Tbl()
End Function
Sub Ouvrir(CheminFichier As String)
Dim AppWord As Object
Dim Doc As Object
Dim Chemin As String
Dim Dossier As String
Dim Fichier As String
'nom du dossier en A1
Dossier = ActiveSheet.Range("A1").Value
'vérifie que l'anti slash est présent en fin de texte
If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
'nom du fichier en A2
Fichier = ActiveSheet.Range("A2").Value
'le dossier parent est le dossier du classeur
Chemin = ThisWorkbook.Path & "\" & Dossier
On Error Resume Next 'au cas où le dossier existe déjà
'création du dossier
MkDir Chemin
'supprime le gestionnaire
On Error GoTo 0
'création de l'application Word
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True 'rendue visible
'ouvre le document
With ActiveSheet.Shapes("Zone de liste 1").ControlFormat
Set Doc = AppWord.Documents.Open(CheminFichier & .List(.ListIndex))
End With
Doc.SaveAs Chemin & Fichier 'et l'enregistre sous...
End Sub
Hervé.
Bonjour Hervé,
Un grand merci pour ton travail.
j'ai le code d'erreur 1004: "Erreur definie par lapplication ou par l'objet"
au niveau de la ligne de code:
S.OnAction = "'Ouvrir """ & Chemin & "'"
je n'arrive pas a la resoudre.
Cordialement
A+
Bonjour,
OnAction et le passage d'arguments pose souvent problème
Teste de cette façon, la variable est déclarée en tête de module de cette façon, il ne devrait pas y avoir de problème :
Dim CheminFichier As String
Sub RemplirListeBox()
Dim S As Shape
Dim Tbl() As String
Dim I As Integer
Dim Ext As String
'adapter le nom de la ListBox dans la zone de nom d'Excel
'à gauche de la barre de formule (définir le nom puis appui sur "Entrée")
Set S = ActiveSheet.Shapes("Zone de liste 1")
'adapter le chemin
CheminFichier = ThisWorkbook.Path & "\Dossier_fichiers\"
'extension du type de fichiers
Ext = ".doc"
'définie la procédure appelée par la ListBox sur clic d'un élément
'en appelant la proc Ouvrir par la ListBox, on est sûr qu'un choix a été fait !
'le dossier pour l'ouverture du fichier est passé en argument
S.OnAction = "Ouvrir"
'supprime les éléments de la liste avant remplissage
S.ControlFormat.RemoveAllItems
'récupère la liste des fichiers du dossier
Tbl() = Fichiers(CheminFichier, Ext)
'et les entre dans la ListBox
For I = 1 To UBound(Tbl)
S.ControlFormat.AddItem Tbl(I)
Next I
End Sub
Function Fichiers(Chemin As String, _
Extension As String) As String() 'la fonction retourne un tableau
Dim Tbl() As String
Dim Fich As String
Dim I As Integer
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'seuls les fichiers avec l'extension voulue
Fich = Dir(Chemin & "*" & Extension)
Do While (Len(Fich) > 0)
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Fich
Fich = Dir()
Loop
Fichiers = Tbl()
End Function
Sub Ouvrir()
Dim AppWord As Object
Dim Doc As Object
Dim Chemin As String
Dim Dossier As String
Dim Fichier As String
'nom du dossier en A1
Dossier = ActiveSheet.Range("A1").Value
'vérifie que l'anti slash est présent en fin de texte
If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
'nom du fichier en A2
Fichier = ActiveSheet.Range("A2").Value
'le dossier parent est le dossier du classeur
Chemin = ThisWorkbook.Path & "\" & Dossier
On Error Resume Next 'au cas où le dossier existe déjà
'création du dossier
MkDir Chemin
'supprime le gestionnaire
On Error GoTo 0
'création de l'application Word
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True 'rendue visible
'ouvre le document
With ActiveSheet.Shapes("Zone de liste 1").ControlFormat
Set Doc = AppWord.Documents.Open(CheminFichier & .List(.ListIndex))
End With
Doc.SaveAs Chemin & Fichier 'et l'enregistre sous...
End Sub
Hervé.
Bonjour,
merci pour ta reponse.
malheureusment le meme probleme persiste
erruer 1004; erreur definie par l'application ou l'objet
S.OnAction = "Ouvrir"
Cordialement A+
Bonjour,
Je viens de faire un test et tout fonctionne sur Excel 2003 et Excel 2007 ! Est-ce que la ListBox s'appelle bien "Zone de liste 1" ?
Hervé.
Bonjour Hervé,
oui la listebox s'apelle bien(" Zone de liste 1").
Je suis sur excel 2010.
Cordialement
A+
Bonjour Hervé,
je viens de trouver l'erreur:
j'utilisais une listbox activeX et non formulaire.
Encore merci pour ton aide
Cordialement
A+