Erreur 1004 methode activeprinter

re

je regarde ça et je te dit

cela dit après j'ai examiner le code de @thev il fonctionne aussi sur W10

Bonjour,

L'anomalie que vous signalez se produit a priori quand le processus d'impression n'est pas entièrement achevé.

Donc vous pouvez essayer une "Application.Wait" avant l'envoi des "SendKeys" ou allonger le temps des "SendKeys".

re

alors déjà

il y avait une erreur dans cette ligne

c'est le chemin complet de l'image qu'il faut pas que le nom

CreateObject("Shell.Application").ShellExecute chemin_fichier & nom_fichier, , chemin_fichier, "print", 0

ensuite

quand ca démarre enfin

il m'a choisi l'imprimante fax

ce qui me fait dire que wmi a flippé

re

@thev ton code fonctionne très bien

a une seule chose près

à la place des app.wait je fait un dowhile timer avec un doevents

car les appwait gèle la macro et donc tout les proc qui ont été lancé par elles

d'autre part les sendkeys me deconnecte le pavé numérique (phénomène bien connu)

alors les sendkeys je les fait par un wscript.shell

pour le coup je l'ai re pétri a ma facon

Sub test2()
    dest$ = Environ("userprofile") & "\DeskTop\tototfffo.pdf"
    imprimer_pdf "H:\Espace fond écran (6).jpg", dest
End Sub

Sub imprimer_pdf(chemin_fichier As String, Destination$)
    Dim tim#

    Const imprimante_pdf As String = "Microsoft Print to PDF"

     CreateObject("Shell.Application").ShellExecute "rundll32.exe", "C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo /pt " & _
                                                                   Chr(34) & chemin_fichier & Chr(34) & " " & Chr(34) & imprimante_pdf & Chr(34), "", "open", 1

    ' Use SendKeys to automate the save dialog
    tim = Timer: Do While Timer - tim < 1.5: DoEvents: Loop
    CreateObject("wscript.shell").SendKeys Mid(Destination, InStrRev(Destination, "\") + 1), True
    'tim = Timer: Do While Timer - tim < 1: DoEvents: Loop
    CreateObject("wscript.shell").SendKeys "{ENTER}", True

End Sub

@PatrickT

C'est vrai que les "sendkeys" déconnectent le pavé numérique. Le "wscript.shell" permet donc d''éviter cet inconvénient, c'est bon à savoir.

re

, déjà je peux vous confirmer que chez moi Wmi déraille complètement et me donne une imprimantes qui n'est pas la bonne

je vous donne mes deux fonctions si vous voulez les tester

Sub testGetP()
MsgBox GetActiveImprimante
End Sub
Function GetActiveImprimante()
    Dim colPrinters As Object, objPrinter As Object
     Set colPrinters = GetObject("winmgmts:\\.\root\CIMV2").ExecQuery("SELECT * FROM Win32_Printer")    'collection d'imprimantes
    For Each objPrinter In colPrinters
        Debug.Print objPrinter.Name & "--" & objPrinter.Default
        If objPrinter.Default = True Then GetActiveImprimante = objPrinter.Name: Exit For
    Next objPrinter
    ' Libérer la mémoire utilisée par les objets
    Set objWMIService = Nothing: Set colPrinters = Nothing: Set objPrinter = Nothing
End Function

Sub ActivePrinterPDF()
ChangePrinter "Microsoft Print to PDF"
End Sub
Function ChangePrinter(nPrinter$)
    With CreateObject("WScript.Network")
        Set imprimantes = .EnumPrinterConnections
        For i = 0 To imprimantes.Count - 1
            If InStr(1, LCase(imprimantes(i)), LCase(nPrinter)) > 0 Then .SetDefaultPrinter nPrinter: MsgBox imprimantes(i): Exit For
        Next

    End With
End Function

@patrickT

Wmi ne déraille pas. Cela signifie tout simplement que l'assistant Windows d'impression des images ("C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo") a son propre paramétrage d'imprimante. Il démarre avec l'imprimante active de Windows mais conserve apparemment tout changement d'imprimante effectué.

@DarkAngel

D'ailleurs, vous pouvez tester l'assistant hors VBA, sur une de vos images en passant par l'interface graphique de Windows via un simple clic droit sur cette dernière.

@patrick : chemin_fichier comprends deja tout le chemin complet de l'image

j'ai par ailleurs tenté votre code mais bloque toujours au meme endroit

   ' Use SendKeys to automate the save dialog
    tim = Timer: Do While Timer - tim < 1.5: DoEvents: Loop
    CreateObject("wscript.shell").SendKeys Mid(CheminDestPDF, InStrRev(CheminDestPDF, "\") + 1), True
    'tim = Timer: Do While Timer - tim < 1: DoEvents: Loop
    CreateObject("wscript.shell").SendKeys "{ENTER}", True

@thev : Donc vous pouvez essayer une "Application.Wait" avant l'envoi des "SendKeys"

j'ai donc mis 5 secs: Application.Wait (Now + TimeValue("0:00:05"))

mais cela ne change rien ceci étant dit je peux interagir sur la fenêtre ./choisir l'imprimante, le format et désactiver l'ajustement mais tout cela a la main

Bonjour Darkangel

dans cette video je te montre pourquoi je préfère faire des do while sur un timer avec un doevents plutot que les application.wait

https://youtu.be/TGgWW9cCnh8

'Imprimer un JPEG en PDF direct sans passer par une feuille
Sub test2()
    Dim Fichier$, FichierPDF$
    Fichier = "H:\Espace fond écran (6).jpg"
    FichierPDF = Environ("userprofile") & "\DeskTop\monimage en pdf.pdf"
    imprimer_pdf Fichier, FichierPDF
End Sub

Sub imprimer_pdf(fichierIMG As String, FichierPDF)
    Dim tim#: Const imprimante_pdf As String = "Microsoft Print to PDF"

    'lance la visionneuse window avec l'ordre d'imprimer avec selection d'imprimante
    CreateObject("Shell.Application").ShellExecute "rundll32.exe", "C:\WINDOWS\System32\shimgvw.dll,ImageView_PrintTo /pt " & _
                                                                   Chr(34) & fichierIMG & Chr(34) & " " & Chr(34) & imprimante_pdf & Chr(34), "", "open", 1

    'on place le dossier cournt sur le dossier de destination  du pdf
    ChDir (Mid(FichierPDF, 1, InStrRev(FichierPDF, "\") - 1))

    ' Utilisation de la simulation des touches pour opérer dans les boites de dialogue

    'on attend 1 seconde  dans une boucle timer avec un doevents
    tim = Timer: Do While Timer - tim < 5: DoEvents: Loop
    'Application.Wait Now + 0.00005

    'on tape le nom du fichier de destination (récuperé avec le mid du chemin complet à partir du dernier path séparator
    CreateObject("wscript.shell").SendKeys Mid(FichierPDF, InStrRev(FichierPDF, "\") + 1), True

    'on attend  1/2 seconde pour taper Enter  ce qui valide l'enregistrement dans le dialogue "enregistrer sous"
    tim = Timer: Do While Timer - tim < 0.5: DoEvents: Loop
    CreateObject("wscript.shell").SendKeys "{ENTER}", True

End Sub

@DarkAngel

Je ne rencontre pas votre problème. Essayer via VBA sans les "SendKeys" en saisissant le nom du fichier pour voir si avez déjà le problème de pivotage de 90°.

Bonjour @thev,

désolé pour mon délai de retour

j'ai tenté de commenter le sendkeys et effectivement le pivotage ne semble pas se faire mais par contre l'image après conversion est totalement coupée sur les bords

Par ailleurs j'ai testé la méthode de PatrickT.

C'est pareil le pdf généré contient l'image mais pivotée et rognée...