Mise en page de fichier

Mise en page de fichier - VB/VBA/VBS - Programmation

Marsh Posté le 29-07-2005 à 09:17:53    

Bonjour,
 
Je suis en panne d'inspiration.
 
J'ai un dossier constitué de plusieurs fichiers word.
Je souhaite mettre une mise en page type sur tous les fichiers. Mon but est donc de copier le texte des fichiers "sources" dans un fichier word "cible" (avec un entête particulière) et enregistrer ce nouveau fichier dans un repertoire cible.
 
Le tout de façon automatique car j'ai plusieurs centaines de fichiers à retravailler.
 
Pour résumé :
Fichier source fichier1.doc => le texte doit etre copié à l'identique dans un fichier cible nouveau1.doc (ayant déjà une mise en page particulière). Ce nouvau fichier doit etre ensuite enregistré.
A automatiser sur tous le dossier des fichiers sources.
 
Merci d'avance pour votre aide.
 
Nico

Reply

Marsh Posté le 29-07-2005 à 09:17:53   

Reply

Marsh Posté le 29-07-2005 à 10:16:44    

Je n'ai pas du etre claire car je n'ai pas de réponse. Laissez tomber mon message précédent !!
 
Aujourd'hui je refais la mise en page fichier par fichier via un code (voir ci-dessous). Mon but est de l'automatiser sur tous les fichiers existant dans le dossier.
 
Voici le code :
Sub mise_en_forme ()
 
Dim MonDoc As Document
 
    Dim OFName As OPENFILENAME
    OFName.lStructSize = Len(OFName)
    OFName.lpstrFilter = "Fichiers WORD (*.doc)" + Chr$(0) + "*.doc"
    OFName.lpstrFile = Space$(254)
    OFName.nMaxFile = 255
    OFName.lpstrFileTitle = Space$(254)
    OFName.nMaxFileTitle = 255
    OFName.lpstrInitialDir = C:\Documents and Settings\Cail14\Mes documents\Divers\Mise en page entete" 'dossier où les fichiers à modifier sont présents
    While MsgBox("Voulez-vous faire une mise en page ?" & vbCrLf & " " & vbCrLf & "         Si oui, choisir le fichier à mettre en forme" & vbCrLf & "         Si non, le fichier se fermera", vbYesNo, "Confirmation demande de mise en page" ) <> vbNo
        If GetOpenFileName(OFName) Then
            Set MonDoc = Documents.OpenC:\Documents and Settings\Cail14\Mes documents\Divers\Mise en page entete\entete.doc" ) ' la ou il y a le fichier avec l'entête pré-formatée
            MonDoc.Range(0, 0).InsertFile Trim(OFName.lpstrFile)
            Application.Dialogs(wdDialogFileSaveAs).Show
             
            MonDoc.Close
        Else
           MsgBox "Fin de mise en page !"
        End If
    Wend
 
Application.Quit
 
End sub
 
Option Explicit
 
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
 
Merci d'avance pour votre aide

Reply

Marsh Posté le 29-07-2005 à 10:34:28    

et là ta question est? :whistle:

Reply

Marsh Posté le 29-07-2005 à 10:40:43    

Comment automatiser mon process ?
En gros je veux lancer une seule fois une macro qui enregistre tous les fichiers du dossier sous la nouvelle mise en forme

Reply

Marsh Posté le 29-07-2005 à 14:45:00    

Personne pour m'aider ?
 
Pour résumer mon problème je voudrais faire une macro qui excute le code ci-dessus automatiquement sur tous les fichiers de mon dossier

Reply

Marsh Posté le 01-08-2005 à 12:41:07    

Je travaille sous excel mais je pense que ca doit etre la mm syntaxe
D'abord il faut ajouter la référence microsft scripting runtime
 
Dim fso As FileSystemObject
Dim fd As Folder
Dim fl As File
 
Set fso = New FileSystemObject
Set fd = fso.GetFolder("chemin de ton dossier" )
'pour chaque fichier du dossier
for each fl in fd.files
   traitement
next
for each f

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed