Il y a actuellement 252 visiteurs
Jeudi 28 Mars 2024
accueilactualitésdossierscomparer les prixtélécharger gratuitement vos logicielsoffres d'emploiforum informatique
Connexion
Créer un compte

VBA word

Besoin d'aide pour configurer un serveur ? Vous souhaitez obtenir des conseils pour référencer votre site ? Un petit souci pour accéder à votre FTP ? Des soucis de programmation en PHP / ASP / HTML / XHTML / XML / XSLT / CSS / ReactJS / AngularJS / VueJS / CGI / PERL / C / MySQL / PostgreSQL ??? Nous avons peut-être la solution dans ce forum ...

VBA word

Message le 29 Juil 2005 09:24

Bonjour,

J'ai besoin d'automatiser ma procédure mais je n'y arrive pas !! :cry:

Mon objectif est de changer la mise en page de plusieurs fichiers word via un fichier pré-formaté.
Je refais aujourd'hui 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 SettingsCail14Mes documentsDiversMise 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 SettingsCail14Mes documentsDiversMise en page enteteentete.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
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 


Message le 29 Juil 2005 13:47

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
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 

Message le 01 Aoû 2005 11:55

Bonjour,

Essaye ça :
Code: Tout sélectionner
Sub MiseEnForme()
    Dim MonDoc As Document
    Dim CheminDesFichiers As String
    Dim NomDuModele As String
    Dim NomEnCours As String

    CheminDesFichiers = "C:\Documents and Settings\Cail14\Mes documents\Divers\Mise en page entete\"
    NomDuModele = "entete.doc"

    ChDir CheminDesFichiers
    NomEnCours = LCase(Dir("*.doc"))

    Do While (NomEnCours <> "")
        If (NomEnCours <> LCase(NomDuModele)) Then
            Set MonDoc = Documents.Open(CheminDesFichiers & NomDuModele, , True)
            MonDoc.Range(0, 0).InsertFile CheminDesFichiers & NomEnCours
            MonDoc.SaveAs CheminDesFichiers & Left(NomEnCours, Len(NomEnCours) - 4) & "_mod.doc"
            MonDoc.Saved = True
            MonDoc.Close
        End If
        NomEnCours = LCase(Dir)
    Loop

End Sub


Les fichiers sont sauvegardés automatiquement sous la forme 'NomOriginal_mod.doc'.
Je ne l'ai pas testé (la flemme de faire des .DOC :P ), donc si ça ne marche pas, dis moi le(s) message(s).

/!\ N'oublie pas de faire une petite sauvegarde avant, même si j'ai confiance, on ne sais jamais :roll: /!\
Avatar de l'utilisateur
RobinSG
Moderateur
Moderateur
 
Messages: 1509
Inscription: 29 Juin 2004 14:26
Localisation: Atys
 

Message le 23 Aoû 2005 15:02

Salut tt le monde et RobinSg en particulier,

Désolé pour le retard, je reviens de vacances et j'avais laissé en plan ce projet avant de partir.

RobinSg c'est le top ta macro ca marche bien, y a t'il par contre un moyen pour qu'il s'arrête une fois que tous les fichiers aient été modifiés ?

Merci d'avance pour votre aide!

Nini
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 

Message le 24 Aoû 2005 07:40

Personne pour m'aider ? :cry:
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 

Message le 24 Aoû 2005 14:49

Salut,

Il y a effectivement pas d'arrêt ^^
Le mieux est, je pense, de faire un tableau contenant le nom des fichiers puis de traiter ce tableau au lieu de parcourir les fichiers en même temps que la modification. (une boucle avec un tableau incrémenté dynamiquement avant la boucle de modification).

Si j'ai le temps je te proposerais quelque chose :P
Avatar de l'utilisateur
RobinSG
Moderateur
Moderateur
 
Messages: 1509
Inscription: 29 Juin 2004 14:26
Localisation: Atys
 

Message le 25 Aoû 2005 10:58

Je veux bien si tu as le temps bien sûr
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 

Message le 25 Aoû 2005 13:16

Re,

Voici donc un petit quelque chose testé succintement... :P

Code: Tout sélectionner
Option Explicit

Sub MiseEnForme()
    Dim MonDoc As Document
    Dim CheminDesFichiers As String
    Dim NomDuModele As String
    Dim NomEnCours As String
    Dim ListeFichiers() As String
    Dim i As Integer

    CheminDesFichiers = "C:Documents and SettingsCail14Mes documentsDiversMise en page entete"
    NomDuModele = "entete.doc"

    ChDir CheminDesFichiers
    NomEnCours = LCase(Dir("*.doc"))
    i = 0
    ReDim ListeFichiers(0)

    ' Construction de la liste des fichiers
    Do While (NomEnCours <> "")
        If (NomEnCours <> LCase(NomDuModele)) Then
            ListeFichiers(i) = NomEnCours
            i = i + 1
            ReDim Preserve ListeFichiers(i)
        End If
        NomEnCours = LCase(Dir)
    Loop

    ' Traitement de la liste
    For i = 0 To UBound(ListeFichiers) - 1
            Set MonDoc = Documents.Open(CheminDesFichiers & NomDuModele, , True)
            MonDoc.Range(0, 0).InsertFile CheminDesFichiers & ListeFichiers(i)
            MonDoc.SaveAs CheminDesFichiers & Left(ListeFichiers(i), Len(ListeFichiers(i)) - 4) & "_mod.doc"
            MonDoc.Saved = True
            MonDoc.Close
    Next
   
'    Do While (NomEnCours <> "")
'        If (NomEnCours <> LCase(NomDuModele)) Then
'            Set MonDoc = Documents.Open(CheminDesFichiers & NomDuModele, , True)
'            MonDoc.Range(0, 0).InsertFile CheminDesFichiers & NomEnCours
'            MonDoc.SaveAs CheminDesFichiers & Left(NomEnCours, Len(NomEnCours) - 4) & "_mod.doc"
'            MonDoc.Saved = True
'            MonDoc.Close
'        End If
'        NomEnCours = LCase(Dir)
'    Loop

    MsgBox "Traitement terminé." & vbCrLf & UBound(ListeFichiers) & " fichier(s) modifié(s).", vbInformation + vbOKOnly, "Voili, voilou..."

End Sub



J'ai laissé en commentaires l'ancienne version (pour infos). Si tu doit modifier souvent des fichiers de cette méthode dans des répertoires et/ou avec des entêtes différents, tu peux rajouter une petite interface pour saisir les données :wink:
Avatar de l'utilisateur
RobinSG
Moderateur
Moderateur
 
Messages: 1509
Inscription: 29 Juin 2004 14:26
Localisation: Atys
 

[réglé]

Message le 30 Aoû 2005 13:28

Merci ca fonctionne parfaitement bien

Tu es un dieu et encore merci
liop49
Apprenti(e) Expert(e)
Apprenti(e) Expert(e)
 
Messages: 118
Inscription: 04 Jan 2003 13:49
 



Sujets similaires

Message WORD GRATUIT
Bonjour tout le monde !Voilà , si j' ai récemment pu lire les documents word que je recevais, je n' ai toujours pas la possibilité d' envoyer des documents aux personnes sous WORD , sauriez-vous où je peux télécharger gratuitement word sans me "faire avoir" ?Merci pour vos réponses , touj ...
Réponses: 19

Message [réglé ailleurs] Ouvrir Word sur page d'accueil, possible ?
Bonsoir,Souhaitant ouvrir tout nouveau document sur la page Accueil dans Word 2013, elle s'ouvre systématiquement sur la page Fichier.Ne sachant pas si c'était la solution, je suis allé dans Fichier/Options/Général/Options de démarrage où j'ai décoché la case Afficher l'écran de démarrage au lanceme ...
Réponses: 5

Message [Réglé] modification d'un mot dans word
bonsoirParfait , j'ai mis en "réglé"
Réponses: 7

Message Quand je veux ouvrir une PJ , c'est word qui s'ouvre
Bonsoir à toutes et à tousMon pb est dans le titre.Quand je veux télécharger ( ouvrir ) une PJ dans un format généralement jpg , c'est word qui s'ouvre avec une fonction conversion de fichier.Pour y arriver je dois faire un clic droit puis ouvrir.Bizarre !
Réponses: 4

Message Transcription audio vers word
Bonjour,Etant étudiante, je cherche un logiciel capable de transcrire plusieurs heures d'entretien (fichier audio .M4a ) en fichier texte.Je sais qu'il existe Dragon dictation mais il est trop cher pour moi .J'ai essayé d'autre logiciel en vain..trop compliquésQuelqu'un a t'il une méthode (et un log ...
Réponses: 7

Message word
Voici mon cv word : *****************Je ne parviens pas à faire en sorte qu'il soit sur une page.Pourriez vous m'expliquer comment faire s'il vous plaît?Merci bien.Cordialement.Mickaël Zaccharie Naïm
Réponses: 2

Message PROBLEME CONVERSATION DOC WORD 2010 TO PDF
Amis,mon probleme c'est qu'on j'essaie de convertir un document word 2010 en PDF , mon document word 2010 se déforme ,alors lorsque j'entre dans office boutton et je choisis enregister sous pdf ou partager ( puis créer en pdf /XPS document ) je reçois un document déformé !! le meme probleme persiste ...
Réponses: 3


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 4 invités


.: Nous contacter :: Flux RSS :: Données personnelles :.