Erreur 1004 methode activeprinter

Bonjour,

mon objectif: imprimer en pdf des jpeg que j'upload via un bouton

mon précédent post résumant trop de soucis, je préfère repartir sur de bonnes bases

pour cela je commence par une macro qui me trouve l'imprimante souhaitée et ensuite je tente de la désigner comme activeprinter

Function FindPrinter(ByVal printerName As String) As String
  Dim arrH, Pr, Printers, Printer As String
  Dim RegObj As Object, RegValue As String
  Const HKEY_CURRENT_USER = &H80000001

    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.Enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Printers, arrH

      For Each Pr In Printers
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Pr, RegValue
        Printer = Pr & " on " & Split(RegValue, ",")(1)
        If InStr(1, Printer, printerName, vbTextCompare) > 0 Then
           FindPrinter = Printer
             Exit Function
        End If
      Next
End Function

Sub test()

Found = FindPrinter("Microsoft Print to PDF ")
MsgBox (Found)
Application.ActivePrinter = Found

End Sub

seulement voila Found me renvoi bien la valeur mais je tombe sur une erreur 1004..

Où est mon erreur svp?

merci

Bonjour Darkangel,

Ce n'est pas ton erreur, mais celle ce Crosoft

Comme ton système est en français, il faut traduire, voici

Sub test()
  Dim Found As String
  Found = FindPrinter("Microsoft Print to PDF ")
  ' Remplacer On par Sur
  Found = Replace(Found, "on", "sur")
  MsgBox (Found)
  Application.ActivePrinter = Found
End Sub

A+

Bonjour Bruno,

Merci à toi, en effet cela solutionne le premier problème :)

je me retrouve donc avec:

Sub PrintToPDF(strFilePath, strPDFPath)
  Dim Found As String
  Found = FindPrinter("Microsoft Print to PDF ")
  ' Remplacer On par Sur
  Found = Replace(Found, "on", "sur")
  MsgBox (Found)
  Application.ActivePrinter = Found

    ' Open the picture file with the default associated application
   RetVal = ShellExecute(0, "print", strFilePath, 0, 0, 0)

End Sub

cependant bien que je déclare l'imprimante print to pdf la ligne retval s'applique sur l'imprimante réseau par défaut.

comment procéder désormais afin que cela soit lancé via Found?

merci

Salut Darkangel,

Pourquoi ne pas simplement définir une zone d'impression dans une feuille
et exporter cette feuille (zone) en PDF

A+

J’avais essayé en générant une nouvelle feuille plaçant l’image dessus puis générer le PDF et enfin supprimer la feuille temporaire

Je me retrouvais avec une image sur page a4 format pdf. J’avais même tenté de jouer sur la zone mais rien n’y a fait et gênerait toujours cela en format a4

Du coup je cherche autrement

Sauf si je m’y prenais mal…

Re,

Effectivement je viens de voir le sujet https://forum.excel-pratique.com/excel/conversion-jpg-en-pdf-via-vba-184145

Il serait bien d'indiqué que le sujet à déjà été travaillé ;-)

bonjour bruno

désole mais pendant le weekend j'ai déconnecter d'excel, de la domotique etc:)

oui on a tenté de gérer cela par ce biais mais le résultat n''a jamais été au rendez vous

et c'est pourquoi je tente de passer via pdf for print mais cela ne semble pas fonctionner non plus

Bonjour,

La seule solution est de changer via VBA, l'imprimante Windows par défaut (donc = imprimante PDF). Ce code permet de le faire :

Sub imprimer()
    Dim nom_imprimante_sel, nom_fichier As String, chemin_fichier As String
    Dim WMIservice As Object, imprimantes As Object, imprimante As Object

    '// sélection et configuration imprimante
    Application.Dialogs(xlDialogPrinterSetup).Show
    nom_imprimante_sel = Split(Application.ActivePrinter, " sur")(0)

    '// imprimante Windows par défaut selon sélection
    Set WMIservice = GetObject("winmgmts:\\" & "." & "\root\cimv2")
    Set imprimantes = WMIservice.ExecQuery("Select * from Win32_Printer")
    For Each imprimante In imprimantes
        If imprimante.Caption = nom_imprimante_sel Then imprimante.SetDefaultPrinter: Exit For
    Next imprimante

Après, il faut certainement remettre par défaut votre imprimante réseau.

merci à vous pour ce code.

toutefois cela m'affiche le menu de choix de l'imprimante

il faut que je clic sur microsoft print to pdf pour que celle ci soit sélectionnée par défaut hors je voudrais que cela se fasse tout seul si possible

il faut que je clic sur microsoft print to pdf pour que celle ci soit sélectionnée par défaut hors je voudrais que cela se fasse tout seul si possible

avec ce code, c'est possible :

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"

    '// 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

End Sub

bonjour tout le monde,

est ceci trop simple ?

Sub Testing()

     With Sheets.Add                         'nouvelle feuille
          myfile = Application.GetOpenFilename(, , "Browse for Files")     'quel fichier JPG, BMP, ...
          Set pic = .Pictures.Insert(myfile)     'ajouter image
          .PageSetup.PrintArea = .Range(pic.TopLeftCell, pic.BottomRightCell)     'la plage d'imprimer
          .PrintPreview                      'exemple
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:="testing_" & Format(Now, "yymmdd_hhmmss"), OpenAfterPublish:=True     'pdf
          Application.DisplayAlerts = False  'sans questions
          .Delete                            'supprimer nouvelle feuille
          Application.DisplayAlerts = True
     End With

End Sub

image existant

Sub Testing2()

     With ActiveSheet
          Set pic = .Shapes(1)               'ajouter image
          Set c = .Range(pic.TopLeftCell, pic.BottomRightCell)     'la plage d'imprimer
          c.PrintPreview                     'exemple
          c.ExportAsFixedFormat Type:=xlTypePDF, Filename:="testing_" & Format(Now, "yymmdd_hhmmss"), OpenAfterPublish:=True     'pdf
     End With

End Sub

Bonjour thev

merci pour ce nouveau code

Quand je lance la macro via

Call imprimer_pdf(nomFic, ThisWorkbook.Path & "\Budget pieces\")

cela me génère l'erreur suivante

sachant que quand je vérifie

MsgBox (nomFic & " " & ThisWorkbook.Path & "\Budget pieces\")

cela me retourne bien:

nomFIc => le nom de l'image.jpg

le chemin )> le répertoire de destination

est ce que je procède correctement?

Enlever l'antislash

Call imprimer_pdf(nomFic, ThisWorkbook.Path & "\Budget pieces")

Merci je viens de tenter d'appliquer votre correctif et on avance a petit pas

Désormais la conversion veut bien se lancer mais me demande le répertoire de destination et le nom à attribuer au fichier

je connais le répertoire de destination ainsi que le nom qui doit avoir le meme que l'image.

Peut on configurer cela pour que cela s'opère tout seul?

Désormais la conversion veut bien se lancer mais me demande le répertoire de destination et le nom à attribuer au fichier

je connais le répertoire de destination ainsi que le nom qui doit avoir le meme que l'image.

Peut on configurer cela pour que cela s'opère tout seul?

Oui, mais pas avec l'imprimante PDF de Microsoft. Il vous faut une imprimante tierce partie d'un logiciel gratuit comme par exemple PDFCreator de Pdfforge. Vous pourrez alors y créer alors un port local contenant l'adresse d'un fichier PDF générique et le renommer ensuite dans votre code.

dans mon cas j'ai adobe acrobat pro

ps: j'ai contourné le soucis avec

Application.Wait (Now + TimeValue("0:00:02")) ' Use SendKeys to automate the save dialog SendKeys FichPDF & "{ENTER}", True 

mais par contre comment s'assurer du dossier de destination peut on forcer le dossier actif sous windows via vba?

est ce que ChDir ThisWorkbook.Path & "\Budget pieces\" est correct?

par contre je n'arrive pas à revenir vers l'imprimante par défaut alors emme qu'en debut de macro j'ai mis:

' save current printer name, then change to PDF writer
sCurrentPrinter = Application.ActivePrinter

et en fin: Application.ActivePrinter = sCurrentPrinter qui à la bonne valeur

par contre je n'arrive pas à revenir vers l'imprimante par défaut alors emme qu'en debut de macro j'ai mis:

Vous ajoutez ce code à la fin de votre procédure :

    
    'restauration imprimante par défaut
    For Each imprimante In imprimantes
        If Application.ActivePrinter Like imprimante.Caption & "*" Then imprimante.SetDefaultPrinter: Exit For
    Next imprimante

re,

j'ai tenté mais cela ne change pas l'imprimante pour autant

For Each imprimante In imprimantes If Application.ActivePrinter Like imprimante.Caption & "Mes_impressionsPOC sur vms-whatdoc" Then imprimante.SetDefaultPrinter: Exit For Next imprimante

imprimante.Caption & "*"

et non

imprimante.Caption & "Mes_impressionsPOC sur vms-whatdoc"