Erreur 1004 methode activeprinter
avec l'ajout de la ligne: Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2") cela me renvoi bien mon imprimante réseau : "\\vms_whatdoc\Mes_impressionsPOC"
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Donc ce code devrait fonctionner :
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Const imprimante_pdf As String = "Microsoft Print to PDF"
Const imprimante_réseau As String = "\\vms_whatdoc\Mes_impressionsPOC"
'// récupération imprimantes Windows
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer")
'// impression via imprimante PDF
'affectation imprimante PDF
For Each imprimante In imprimantes
If imprimante.Caption = imprimante_pdf Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
'impression fichier
CreateObject("Shell.Application").ShellExecute nom_fichier, , chemin_fichier, "print", 0
'// restauration imprimante réseau
restaurer_imprimante_réseau imprimante_réseau
End Sub
Sub restaurer_imprimante_réseau(nom_imprimante As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer Where Local = FALSE")
For Each imprimante In imprimantes
If imprimante.Caption = nom_imprimante Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
End Sub
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Vérifier l'égalité en ajoutant une MsgBox :
Sub restaurer_imprimante_réseau(nom_imprimante As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer Where Local = FALSE")
For Each imprimante In imprimantes
MsgBox imprimante.Caption & " = " & nom_imprimante
If imprimante.Caption = nom_imprimante Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
End Sub
Lol c'etait juste - au lieu de _ :)
à cette ligne
Const imprimante_réseau As String = "\\vms_whatdoc\Mes_impressionsPOC"
Soit
Const imprimante_réseau As String = "\\vms-whatdoc\Mes_impressionsPOC"
Votre macro fonctionne donc nickel merci !!!!
Bonjour Bruno
c’était deja fait mais j’ai recliqué au cas où.
Bonjour à vous tous
Je vous recontacte au sujet de ce post car j'ai change de pc et le code ne fonctionne plus
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Const imprimante_pdf As String = "Microsoft Print to PDF"
Const imprimante_réseau As String = "\\vms-whatdoc\Mes_impressionsPOC"
'// récupération imprimantes Windows
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer")
'// impression via imprimante PDF
'affectation imprimante PDF
For Each imprimante In imprimantes
If imprimante.Caption = imprimante_pdf Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
'impression fichier
CreateObject("Shell.Application").ShellExecute nom_fichier, , chemin_fichier, "print", 0
nomFicpdf = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
CheminDestPDF = ThisWorkbook.Path & "\Budget pieces\" & nomFicpdf
Application.Wait (Now + TimeValue("0:00:02"))
' Use SendKeys to automate the save dialog
SendKeys CheminDestPDF & "{ENTER}", True
'// restauration imprimante réseau
restaurer_imprimante_réseau imprimante_réseau
End Sub
Sub restaurer_imprimante_réseau(nom_imprimante As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer Where Local = FALSE")
For Each imprimante In imprimantes
' MsgBox imprimante.Caption & " = " & nom_imprimante
If imprimante.Caption = nom_imprimante Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
End Sub
Avant tout fonctionnait bien et le fichier converti en pdf avec le bon nom
mais désormais je bute sur une nouvelle fenêtre:
on voit que l'image que j'ai sélectionné apparait bien mais que déjà l'imprimante n'est pas la bonne
pourtant quand je tente un msgbox je trouve bien Microsoft Print to PDF
For Each imprimante In imprimantes
If imprimante.Caption = imprimante_pdf Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
bien présent sur l'ordi
une idée de comment je pourrais procéder ou bypasser cette fenêtre?
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonsoir,
Le souci est que l'imprimante par défaut n'est pas reconnue avant la fin de la procédure. Il faut donc la terminer et lancer une nouvelle procédure. Comme suit :
Sub imprimer_image(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Const imprimante_pdf As String = "Microsoft Print to PDF"
'// récupération imprimantes Windows
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer")
'// impression via imprimante PDF
'affectation imprimante PDF
For Each imprimante In imprimantes
If imprimante.Caption = imprimante_pdf Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
'impression fichier PDF
Application.OnTime Now + TimeValue("00:00:01"), "'imprimer_pdf " & Chr(34) & chemin_fichier & Chr(34) & ", " & Chr(34) & nom_fichier & Chr(34) & ", " & Chr(34) & dateen & Chr(34) & ", " & Chr(34) & ligne & "'"
End Sub
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Const imprimante_réseau As String = "\\vms-whatdoc\Mes_impressionsPOC"
'impression fichier
CreateObject("Shell.Application").ShellExecute nom_fichier, , chemin_fichier, "print", 0
nomFicpdf = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
CheminDestPDF = ThisWorkbook.Path & "\Budget pieces\" & nomFicpdf
Application.Wait (Now + TimeValue("0:00:02"))
' Use SendKeys to automate the save dialog
SendKeys CheminDestPDF & "{ENTER}", True
'// restauration imprimante réseau
restaurer_imprimante_réseau imprimante_réseau
End Sub
Sub restaurer_imprimante_réseau(nom_imprimante As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer Where Local = FALSE")
For Each imprimante In imprimantes
' MsgBox imprimante.Caption & " = " & nom_imprimante
If imprimante.Caption = nom_imprimante Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
End Sub
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonsoir,
Par ailleurs, vous avez une solution beaucoup plus simple pour imprimer une image en PDF sans passer par le changement de l'imprimante par défaut de Windows.
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Dim nom_image As String
Const imprimante_pdf As String = "Microsoft Print to PDF"
'// impression via imprimante PDF
nom_image = chemin_fichier & "\" & nom_fichier
CreateObject("Shell.Application").ShellExecute "rundll32.exe", "C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo /pt " & Chr(34) & nom_image & Chr(34) & " " & Chr(34) & imprimante_pdf & Chr(34), "", "open", 1
nomFicpdf = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
CheminDestPDF = ThisWorkbook.Path & "\Budget pieces\" & nomFicpdf
Application.Wait (Now + TimeValue("0:00:02"))
' Use SendKeys to automate the save dialog
SendKeys CheminDestPDF & "{ENTER}", True
End Sub
Bonjour Thev et merci pour votre retour
toutefois aucune des deux propositions ne semble fonctionner
Du reste dans le cadre la version simplifiée ce qui serait idéal l'image n'est pas du tout convertie
Je vais donc tenter d'expliquer un peu plus les choses
dans mon fichier chaque nouvelle ligne possède un bouton upload qui permet de sélectionner l'image à convertir en pdf dont voici le code
Sub Upload_Click()
Dim myfile As String
Dim oFSO As Object
Dim Sh As Shape
Dim CheminDest As String
Dim nomFic As String
Dim FichPDF As String
Set Sh = ActiveSheet.Shapes(Application.Caller) 'recupere le bouton cliqué
Dim ligne As Long
Dim colonne As Long
ligne = Sh.TopLeftCell.Row 'N° ligne du bouton
colonne = Sh.TopLeftCell.Column 'N° colonne du bouton
If MsgBox("Confirmation Ligne: " & ligne, vbYesNo, "Demande de confirmation") = vbYes Then
If (Worksheets("Ecriture").Range("F" & ligne) = "") Then Exit Sub
datefr = Worksheets("Ecriture").Range("A" & ligne)
dateen = Format(datefr, "yyyy-mm-dd")
nomFic = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".jpg"
CheminDest = ThisWorkbook.Path & "\Budget pieces\" & nomFic
nomFic2 = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
Set oFSO = CreateObject("Scripting.FileSystemObject")
myfile = Application.GetOpenFilename(, , "Browse for Files")
If myfile <> "" Then
nam = Right(myfile, DernierePosition(myfile, ".") - 1)
If (nam <> "pdf") Then
'TextToDisplay:=dateen & " - " & Worksheets("Ecriture").Range("F" & ligne)
oFSO.CopyFile myfile, CheminDest, True
With Worksheets("Ecriture")
.Hyperlinks.Add Anchor:=.Range("K" & ligne), _
Address:="Budget%20pieces\" & nomFic2, _
TextToDisplay:="" & Worksheets("Ecriture").Range("F" & ligne)
End With
Worksheets("Ecriture").Range("K" & ligne).Font.Size = 9
Sh.Select
Sh.Delete
FichPDF = Split(CheminDest, ".")(0) & ".pdf"
ChDir ThisWorkbook.Path & "\Budget pieces\"
Call imprimer_pdf(ThisWorkbook.Path & "\Budget pieces", CheminDest, dateen, ligne)
Else
dest = ThisWorkbook.Path & "\Budget pieces\" & nomFic2
oFSO.CopyFile myfile, dest, True
With Worksheets("Ecriture")
.Hyperlinks.Add Anchor:=.Range("K" & ligne), _
Address:="Budget%20pieces\" & nomFic2, _
TextToDisplay:="" & Worksheets("Ecriture").Range("F" & ligne)
' TextToDisplay:=dateen & " - " & Worksheets("Ecriture").Range("F" & ligne)
End With
Worksheets("Ecriture").Range("K" & ligne).Font.Size = 9
Sh.Select
Sh.Delete
End If
End If
If Application.Wait(Now + TimeValue("0:00:04")) Then
Kill myfile
End If
If (nam = "jpg") Then
If Application.Wait(Now + TimeValue("0:00:4")) Then
Kill ThisWorkbook.Path & "\Budget pieces\" & dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".jpg"
End If
End If
End If
End Sub
cela lançait ensuite la macro imprimer_pdf qui avant fonctionnait si cas d'une image et non d'un pdf
si je tente de rajouter votre macro simplifié l'image est bien mise dans le dossier de destination mais rien ne se passe et le format reste en jpg ici
- Messages
- 4'094
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Je ne sais pas où est votre problème mais le code ci-dessous fonctionne chez moi sans problème pour une image :
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Dim nom_image As String
Const imprimante_pdf As String = "Microsoft Print to PDF"
'// impression via imprimante PDF
nom_image = chemin_fichier & "\" & nom_fichier
CreateObject("Shell.Application").ShellExecute "rundll32.exe", "C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo /pt " & Chr(34) & nom_image & Chr(34) & " " & Chr(34) & imprimante_pdf & Chr(34), "", "open", 1
nomFicpdf = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
CheminDestPDF = ThisWorkbook.Path & "\Budget pieces\" & nomFicpdf
' Use SendKeys to automate the save dialog
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys CheminDestPDF, True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{ENTER}", True
End Sub
Bonjour,
Effectivement, merci à vous, j'ai du trouver la faille mais parfaitement fonctionnel :) nom_image etant nom_fichier dans mon cas !
Fonctionne nickel!!
Bonjour,
sans vouloir abuser @thev serait il possible d'ajouter un code permettant de ne pas ajuster et surtout mettre dans le bon sens (à l'heure actuelle quand converti mis sur le coté)?
merci par avance
@thev
Bonjour, je me permet de vous relancer au sujet du topic ci dessus.
merci par avance
Bonjour à tous
je crois qu'il y a confusion
ne pas confondre
- activeprinter qui est l'imprimante active engagée dans excel
- et l'imprimante sélectionnée dans le gestionnaire d'imprimante dans Windows
Concrètement ça veut dire quoi : et bien que la gestion d'impression hors contexte excel( en l'occurrence ici un fichier jpg)
va devoir se faire extérieurement mais!!! on a la possibilité de piloter l'impression externe par vba
exemple ici l'image va être imprimée avec l'imprimante selectionnée de Windows
Sub test()
Dim Fichier$
Fichier = "H:\Espace fond écran (6).jpg"
ImprimerFichier Fichier
End Sub
'modele 2
Function ImprimerFichier(ByVal Fichier As String)
By patricktoulon
CreateObject("Shell.Application").Namespace(0).ParseName(Fichier).InvokeVerb ("Print")
'Application.Wait (Now + TimeValue("0:00:03"))
'Shell "Taskkill /im AcroRd32.exe /f", 0 'changer "AcroRd32.exe" pour le nom de ton app qui ouvre tes pdf pour tuer son processus
End Function
en l’occurrence j'ai dans mon Windows l'imprimante pdf de Microsoft qui est sélectionnée
maintenant a supposer que vous n'ayez pas l'imprimante windows pdf sélectionnée
là encore on peut changer l'imprimante dans les paramètre windows par vba
pour cela je vous renvoie a ma petite boite de dialogue perso ici:
et l'on voit bien que que l'on peut changer l'imprimante dans windows par vba
Bon d'accords c'est sur W 7 mais ça fonctionne toujours sur W10
les grands crack du forum n'auront aucun mal a repiquer du code de ma fausse boite de dialoque imprimante windows
et l'ajouter a la fonction d'impression dument citée un peu plus haut dans ma réponse
maintenant si ton intention est d'imprimer ton jpeg et de paramétrer sa taille dans une feuille A4(même en pdf)
il faudra alors jouer avec les zone d'impression , les hpagebreaks et vpagebreaks
et là encore placer l'image centrée dans la page
pour cela aussi tu trouvera ici une petite fonction toute simple ( dans le lien ci dessous ) qui consiste a placer une image au centre d'une plage le plus grand possible en respectant l'aspect ratio de l'image
si je vois que personne n'y arrive je reviendrais
Merci Patrick pour votre retour qu'il va me falloir approfondir et tester avant de revenir vers vous car là tout semble se compliquer
Toutefois mon code ci dessous fonctionnait parfaitement sur mon ancien pc et suite au changement de pc je bute juste sur la fenêtre windows dans laquelle je ne sais pas changer le nom de l'imprimante ni décocher adapter l'image ni choisir le format alors qu'avant rien à choisir ..
Sub imprimer_pdf(chemin_fichier As String, nom_fichier As String, dateen, ligne)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Const imprimante_pdf As String = "Microsoft Print to PDF"
Const imprimante_réseau As String = "\\vms-whatdoc\Mes_impressionsPOC"
'// récupération imprimantes Windows
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer")
'// impression via imprimante PDF
'affectation imprimante PDF
For Each imprimante In imprimantes
If imprimante.Caption = imprimante_pdf Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
'impression fichier
CreateObject("Shell.Application").ShellExecute nom_fichier, , chemin_fichier, "print", 0
nomFicpdf = dateen & " - " & Worksheets("Ecriture").Range("F" & ligne) & ".pdf"
CheminDestPDF = ThisWorkbook.Path & "\Budget pieces\" & nomFicpdf
Application.Wait (Now + TimeValue("0:00:02"))
' Use SendKeys to automate the save dialog
SendKeys CheminDestPDF & "{ENTER}", True
'// restauration imprimante réseau
restaurer_imprimante_réseau imprimante_réseau
End Sub
Sub restaurer_imprimante_réseau(nom_imprimante As String)
Dim WMIservice As Object, imprimantes As Object, imprimante As Object
Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer Where Local = FALSE")
For Each imprimante In imprimantes
' MsgBox imprimante.Caption & " = " & nom_imprimante
If imprimante.Caption = nom_imprimante Then imprimante.SetDefaultPrinter: Exit For
Next imprimante
End Sub