Word vba imprimer tout un répertoire de fichier *.doc tous les documents d'un dossier

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 510 fois - Téléchargée 30 fois

Commenter

Contenu du snippet

Bon voilà le problème :
imprimer un dossier rempli de document word *.doc.
La solution c'est une source sous la forme d'un document word avec un tas de macros dedans qui permettent de le faire en gros :
un module appeler Newmacros et un form appeller userform1
sur le form deux combobox et un bouton valider

il ya aussi un petit truc pour éviter le que message "les marges d'impressions ...etc"

voilà je joins la source du document doc en office 97

bon Codage à tous !

Source / Exemple : 


'code dans le module

Private Declare Function EnumPrintersA Lib "Winspool.drv" _
  (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, _
  pPrinterEnum As Long, ByVal cdBuf As Long, _
  pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32" _
  (ByVal lpString As Any) As Long
Private Declare Function lstrcpyA Lib "Kernel32" _
  (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Public Type BROWSEINFO

hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'variables discussion avec le form
Public printer As String
Public nbre As String
Public exitall As Boolean

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Sub IMPRIME_TOUT()
'
' Macro1 Macro
' Macro enregistrée le 19/07/2004 par supervisor
'
Dim rep As String
Dim enuma As Integer
enuma = 0
exitall = False

'On demande à l'utilisateur l'emplacement du dossier
Dossier = GetDirectory
'petites vérif sur le dossier
If Len(Dossier) > 3 Then
Dossier = Dossier & "\"
End If
If Dossier = "" Then
MsgBox "Pas de dossier sélectionné"
Exit Sub
End If

'on demande à l'usager l'imprimante et le nbre de feuilles à imprimer
UserForm1.Show
'petites vérif si tout est bien saisi sinon on se tire
If exitall = True Then Exit Sub

'obtient le premier fichier ou répertoire qui est dans "c:\"
rep = Dir(Dossier)
'MsgBox rep
'boucle tant que le répertoire n'a pas été entièrement parcouru
Do While (rep <> "")

'teste si c'est un fichier ou un répertoire
If (GetAttr(Dossier & rep) And vbDirectory) = vbDirectory Then '

' on pourrait faire un truc si c un dossier
'sinon c un fichier et on vérifie si c un doc
ElseIf (Right$(rep, 4) = ".doc") Then
'on envoi à l'impression
imprime Dossier, rep
'on compte combien d'impression l'on fait
enuma = enuma + 1
End If

'Else: MsgBox Dossier & rep
   'passe à l'élément suivant
rep = Dir
Loop

'Si il y a rien d'imprimer on le dit
If enuma = 0 Then

     MsgBox "RIEN A IMPRIMER DANS" & rep
     Exit Sub
     End If
     

MsgBox enuma & " fichiers trouvés  et imprimés" & "       0_o/         c fini"
End Sub

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1

x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
'Dossier = GetDirectory & ""
Dossier = GetDirectory
Else
GetDirectory = ""
End If
End Function

Sub imprime(chemin, docu)
'
' Macro2 Macro
' Macro enregistrée le 19/07/2004 par supervisor
'

ChangeFileOpenDirectory (chemin)
     'MsgBox chemin & docu
    
     
Documents.Open FileName:=docu, ConfirmConversions:= _
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto

        'petite note sur print out avec display alert false et background false
        'ainsi on n'a pas de message spéciaux types les marges d'impression etc...
   Application.ActivePrinter = printer
    With Application
   .DisplayAlerts = wdAlertsNone
    .PrintOut FileName:=docu, Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=nbre, Pages:="", PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=False, PrintToFile:= _
        False
        .DisplayAlerts = wdAlertsAll
        
        End With
        
    ActiveWindow.Close
End Sub

'fin du code dans le module

'code dans le form

Private Declare Function EnumPrintersA Lib "Winspool.drv" _
  (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, _
  pPrinterEnum As Long, ByVal cdBuf As Long, _
  pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32" _
  (ByVal lpString As Any) As Long
Private Declare Function lstrcpyA Lib "Kernel32" _
  (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Function Imprimantes()
  Dim PrinterEnum() As Long, Impr() As String
  Dim z As String
  
  Dim Needed As Long, Returned As Long, i As Integer
  EnumPrintersA 2, vbNullString, 5, 0, 0, Needed, 0
  If Needed = 0 Then Exit Function
  ReDim PrinterEnum(Needed / 4)
  EnumPrintersA 2, vbNullString, 5, PrinterEnum(0), _
  Needed, Needed, Returned
  ReDim Impr(1 To Returned)
  For i = 1 To Returned
    Impr(i) = Space$(lstrlenA(PrinterEnum(i * 5 - 5)))
    lstrcpyA Impr(i), PrinterEnum(i * 5 - 5)
 'z = Impr(i).DeviceName
 'z = z & "u"
 
 'MsgBox z
 'UserForm1.ComboBox2.AddItem (z.DeviceName)
 
 
 
  Next i
  Imprimantes = Impr
  
  
End Function

Private Sub GetPrinters()
   Dim cbo                 As ComboBox
    Dim sPname              As String
    Dim C                   As Byte
    Dim i                   As Byte
    'Dim prt                 As printers
    
   
    Set cbo = Me.cboPrinters
    C = cbo.ListCount
'Clean the cbo
    If C > 0 Then
     For i = 0 To C
        cbo.RemoveItem (i)
     Next i
    End If
    i = 0: C = 0
    For Each prt In Imprimantes
       'sPname = C & ";" & prt.DeviceName
        cbo.AddItem (prt)
'This line is just to get the default printer to display it as the first option
        
    Next prt
   Me.cboPrinters = i
 
    Set prt = Nothing
   
End Sub

Private Sub CommandButton1_Click()
NewMacros.printer = cboPrinters.Text
If (cboPrinters.Text = "0") Then
UserForm_Terminate
End If

NewMacros.nbre = ComboBox2.Text
UserForm1.Hide

End Sub

Private Sub UserForm_Initialize()

Dim Impr

GetPrinters

ComboBox2.AddItem ("1")
ComboBox2.AddItem ("2")
ComboBox2.AddItem ("3")
ComboBox2.AddItem ("4")
ComboBox2.AddItem ("5")
ComboBox2.AddItem ("6")
ComboBox2.AddItem ("7")

End Sub

Private Sub UserForm_Terminate()
MsgBox "Pas d'imprimante sélectionné"
NewMacros.exitall = True
End Sub

A voir également

Ajouter un commentaire

Commentaires

Signaler
Alazrian
Messages postés
4
Date d'inscription
mercredi 9 janvier 2008
Statut
Membre
Dernière intervention
27 février 2008
 -
J'ai essayé de rajouté comme tu l'a fait pour qu'il n'affiche pas de message d'alerte pour les marges :
objword.DisplayAlerts=wdAlertsNone
Mais rien a faire il me l'affiche quand même.
D'où est-ce que ca peut venir ?
Signaler
jddz
Messages postés
5
Date d'inscription
lundi 14 juin 2004
Statut
Membre
Dernière intervention
21 décembre 2006
 -
En effet, Il est certain que l'objet Printer dans word 2002 a évolué.
Je ne suis pas en mesure de coder moi même une classe d'accès universelle dans toutes les versions de microsoft office...reste à le tester sous 2007 !

Cette version fonctionne assez bien sous 97.
(en tout cas ma secrétaire ne passe pas sa vie à imprimer des words ///)
Signaler
grivouille
Messages postés
1
Date d'inscription
lundi 6 novembre 2006
Statut
Membre
Dernière intervention
7 novembre 2006
 -
C'est vraiment ce que je recherchais!! :-).
Malheureusement je ne parviens (visiblement) pas à le faire fonctionner complètement avec Word 2002 SP3. J'ai une erreur 461 et le débugger pointe sur "Me.cboPrinters" (ligne 225).
Etant néophyte, je ne sais pas s'il sagit d'un problème de compatibilité entre les versions de word, ou si j'ai fait une fausse manoeuvre.

Avez-vous rencontré le même problème ?

Je vous remercie d'avance pour vos réponse et pour le temps que vous y aurai consacré :-).

Bonne journée à vous
Signaler
59clark
Messages postés
1
Date d'inscription
mardi 5 septembre 2006
Statut
Membre
Dernière intervention
5 septembre 2006
 -
Bonjour, code impec !!
Sela devrait bien m'aider...
J'aimerais imprimer une liste de fichier contenu dans une table, mais les fichiers ne sont pas tous du type Word, ni office d'ailleur... Pourrais tu m'aider ?
Signaler
jddz
Messages postés
5
Date d'inscription
lundi 14 juin 2004
Statut
Membre
Dernière intervention
21 décembre 2006
 -
Tout est dans cette petite note, où l'on neutralise les alertes cf les paramètres employés.
Biensur ce n'est pas de moi car c'est vraiement chiadé, mais je l'ai découvert sur un truc complètement différement et je l'ai adapté au cas de figure....


'petite note sur print out avec display alert false et background false
'ainsi on n'a pas de message spéciaux types les marges d'impression etc...
Application.ActivePrinter = printer
With Application
.DisplayAlerts = wdAlertsNone
.PrintOut FileName:=docu, Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=nbre, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=False, PrintToFile:= _
False
.DisplayAlerts = wdAlertsAll
Afficher les 6 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.