Soyez le premier à donner votre avis sur cette source.
Snippet vu 17 510 fois - Téléchargée 30 fois
'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
Commentaires
objword.DisplayAlerts=wdAlertsNone
Mais rien a faire il me l'affiche quand même.
D'où est-ce que ca peut venir ?
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 ///)
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
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 ?
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
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.