Une macro ouvrant la fenêtre " Imprimer "

brunounours

XLDnaute Nouveau
Bonjour,
J’ai une petite question qui je suis sur ne vous posera pas de problèmes pour bien commencer la semaine.

Je souhaite imprimer un Userform à l'aide d'un bouton.

J'utilise le code suivant:

Private Sub CommandButton2_Click()
UserFormVerificacion2.PrintForm
End Sub

Mon problème, est qu'il me lance l'impression directement sur l'imprimante par défaut.
Je souhaiterai qu'il m'ouvre la fenêtre "imprimer" pour par exemple pouvoir sélectionner l'imprimante ou éventuellement imprimer un PDF.
Par ailleurs j’aimerai aussi pourvoir choisir d’ouvrir un aperçu avant impression avant d’imprimer.
Merci d'avance pour vos réponses.

Bruno.
 

MJ13

XLDnaute Barbatruc
Re : Une macro ouvrant la fenêtre " Imprimer "

Bonjour à tous

Tu peux tester ce code issu d'une discussion initiée par APDF1 que je trouve intéressant :):

https://www.excel-downloads.com/threads/code-tres-lent.173005/


Code:
Sub Choix_Imprimante()
'http://www.excel-downloads.com/forum/173005-code-tres-lent.html
Application.Dialogs(xlDialogPrinterSetup).Show
'ActiveSheet.PrintOut
End Sub
 

brunounours

XLDnaute Nouveau
Re : Une macro ouvrant la fenêtre " Imprimer "

salut,

J'ai essayé cette solution, ça m'ouvre bien la boite de dialogue pour selectioner l'imprimante, mais quand je choisis n'importe quelle imprimante ca n'effectue pas le changement et continue de l'envoyer sur l'imprimante par defaut initiale.

J'ai une autre solution qui me permet de changer d'imprimante mais qui Imprime ma feuille et pas mon UserForm:

Code:
Application.Dialogs(xlDialogPrint).Show
 

MJ13

XLDnaute Barbatruc
Re : Une macro ouvrant la fenêtre " Imprimer "

Re

Ah oui, imprimer un USf, cela m'était sorti de l'esprit (es tu la :eek:).

Sinon, il faudrait changer l'imprimante par défaut.

J'ai trouvé ce code pour avoir le nom de l'imprimante par défaut. Je te laisse faire le contraire: changer l'imprimante par défaut :confused:.

Tiens nous au courant avec le code définitif :).
 

Pièces jointes

  • ImprimanteParDéfaut.xls
    32 KB · Affichages: 61

brunounours

XLDnaute Nouveau
Re : Une macro ouvrant la fenêtre " Imprimer "

Voila la démarche que j'ai effectuè:

J'ai crèè un nouveau module puis j'ai plus ou moins coller ton code :

Code:
Const HWND_BROADCAST = &HFFFF
Const WM_WININICHANGE = &H1A
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Dim Chemin As String
Dim NC As Long
Dim Ret As String
 
Public StrImprimante As String
 
Sub ChangeImprimanteParDéfaut(Nom As String)
 Chemin = String(260, 0)
 Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "\win.ini"
 Ret = String(255, 0)
 NC = GetPrivateProfileString("Devices", Nom, "", Ret, 255, Chemin)
 Ret = Left(Ret, NC)
 WritePrivateProfileString "windows", "device", Nom & "," & Ret, Chemin
 SendMessage HWND_BROADCAST, WM_WININICHANGE, 0, "windows"
End Sub
 
 
Function ImprimanteParDéfaut() As String
 Chemin = String(260, 0)
 Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "\win.ini"
 Ret = String(255, 0)
 NC = GetPrivateProfileString("windows", "device", "", Ret, 255, Chemin)
 Ret = Left(Ret, NC)
 NC = InStr(Ret, ",")
 ImprimanteParDéfaut = Left(Ret, NC - 1)
End Function

Ensuite dans la commande du click pour l'impression,
j'ai mis ce deuxieme:

Code:
'Mémorise l'imprimante par défaut
StrImprimante = ImprimanteParDéfaut
 
'Choix de l'imprimante
Application.Dialogs(xlDialogPrinterSetup).Show
 
'Modification de l'imprimante par défaut
ChangeImprimanteParDéfaut Application.ActivePrinter
 
'Impression de la userform
UserFormVerificacion2.PrintForm
 
'remise en place de l'imprimante par défaut
ChangeImprimanteParDéfaut StrImprimante


qd je click sur bon bouton imprimer il me demande bien quelle imprimante je souhaite. Je la selectionne et il me renvoie un message d'éreur: "
Run-time error '484':

Problem getting printer information for the system. Make sure the printer is set up correctly."

Si je clique sur "Debug", il me surligne en jaune "UserFormVerificacion2.PrintForm"

aprés aucune de mes UserForms ne veulent se lancer :-(

Je sèche :-S

Une idèe du problème?

Merci, Bruno
 

MJ13

XLDnaute Barbatruc
Re : Une macro ouvrant la fenêtre " Imprimer "

Re

Sinon tu crées un Userform et tu mets un combobox et un Command Button.

Ensuite, tu y places ce code (j'ai rajouté un code pour avoir la liste des imprimantes).

Et la, tu as tout pour réussir :):

Code:
Const HWND_BROADCAST = &HFFFF
Const WM_WININICHANGE = &H1A
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Dim Chemin As String
Dim NC As Long
Dim Ret As String
 
Private Sub CommandButton1_Click()
Imprdef = ComboBox1
ProcédureImPrimanteParDéfaut (Imprdef)
'Me.PrintForm
End Sub
 
Private Sub UserForm_Initialize()
'ComboBox1.RowSource = "listeImpr"
ComboBox1.AddItem "NomImprimante1"
ComboBox1.AddItem "NomImprimante2"
ComboBox1.AddItem "NomImprimante3"
End Sub
 
Private Sub ProcédureImPrimanteParDéfaut(Imprdef)
 'http://www.excelabo.net/trucs/imprimante_defaut
 'HP LaserJet 3200 Series PS = Nom de l'imprimante apparaissant
 ' dans la fenêtre " imprimante" du panneau de configuration
  'ChangeImprimanteParDéfaut ("HP LaserJet 3200 Series PS")
   ChangeImprimanteParDéfaut (Imprdef)
  End Sub
 
  Sub ChangeImprimanteParDéfaut(Nom As String)
'http://www.excelabo.net/trucs/imprimante_defaut
 Chemin = String(260, 0)
 Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "\win.ini"
 Ret = String(255, 0)
 NC = GetPrivateProfileString("Devices", Nom, "", Ret, 255, Chemin)
 Ret = Left(Ret, NC)
 WritePrivateProfileString "windows", "device", Nom & "," & Ret, Chemin
 SendMessage HWND_BROADCAST, WM_WININICHANGE, 0, "windows"
 End Sub
 
Private Sub ListPrinters()
'http://www.generation-nt.com/vba-liste-imprimantes-disponibles-entraide-776771.html
Dim objWMIService As Object
Dim objItem As Object
Dim colItems As Object
Dim strComputer As String
Dim i As Integer
[A1] = "Imprimante"
[B1] = "Port"
i = 2
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery _
("SELECT * FROM Win32_Printer")
For Each objItem In colItems
With ActiveSheet
.Range("A" & i) = objItem.name
.Range("B" & i) = objItem.PortName
i = i + 1
End With
Next
Columns("A:B").Select
Selection.Columns.AutoFit
Set colItems = Nothing
Set objWMIService = Nothing
End Sub
 
Dernière édition:

brunounours

XLDnaute Nouveau
Re : Une macro ouvrant la fenêtre " Imprimer "

Merci, ca marche bien pour imprimer l'UserForm.

En revanche, cela me renvoie un autre problème.
Apres mon impression, et après avoir fermé l'UserForm imprimé, aucune de mes macros ne fonctionnent:
si je clique sur un bouton qui lance n'importe quelle Userform, un message d'erreur apparait (cf piece jointe).
Si je clique sur debug il me surligne: UserForm.Show

Je n'ai trouvé d'autre solution que de fermer mon fichier et de le rouvrir: Ce qui est un peu contraignant si je dois le faire après chaque impression.

As-tu une solution?

Cdt Bruno
 

Lone-wolf

XLDnaute Barbatruc
Re : Une macro ouvrant la fenêtre " Imprimer "

Bonjour MJ13, brunounours,

je ne sais pas si ça peut-être utile:

Code:
    Const HWND_BROADCAST = &HFFFF
    Const WM_WININICHANGE = &H1A
    Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
    Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
    Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
    Dim Chemin As String
    Dim NC As Long
    Dim Ret As String
     
    Private Sub CommandButton1_Click()
    Imprdef = ComboBox1
    ProcédureImPrimanteParDéfaut (Imprdef)
    Application.Dialogs(xlDialogPrint).Show    'ici changé par Me.PrintForm
    End Sub
     
    Private Sub UserForm_Initialize()
    ComboBox1.AddItem "HP Color LaserJet 1600"
    ComboBox1.AddItem "PDFCreator"
    End Sub
     
    Private Sub ProcédureImPrimanteParDéfaut(Imprdef)
      ChangeImprimanteParDéfaut (Imprdef)
      End Sub
     
    Sub ChangeImprimanteParDéfaut(nom As String)
    Chemin = String(260, 0)
     Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "\win.ini"
     Ret = String(255, 0)
     NC = GetPrivateProfileString("Devices", nom, "", Ret, 255, Chemin)
     Ret = Left(Ret, NC)
     WritePrivateProfileString "windows", "device", nom & "," & Ret, Chemin
     SendMessage HWND_BROADCAST, WM_WININICHANGE, 0, "windows"
     End Sub

La fenêtre Imprimer s'affiche bien avec l'imprimante choisie.


A+ :cool:
 

brunounours

XLDnaute Nouveau
Re : Une macro ouvrant la fenêtre " Imprimer "

Bonjour,

toujours le meme probleme:

Apres mon impression, et après avoir fermé l'UserForm imprimé, aucune de mes macros ne fonctionnent:
si je clique sur un bouton qui lance n'importe quelle Userform, un message d'erreur apparait (cf piece jointe).
Si je clique sur debug il me surligne: UserForm.Show

Je n'ai trouvé d'autre solution que de fermer mon fichier et de le rouvrir: Ce qui est un peu contraignant si je dois le faire après chaque impression.

Une idée: peut-être existe t'il un code pour remettre les parametres de base de excel par defaut que j'executerai à la fermeture de mon UserForm ?

Une idée pour ce problème?

Cdt Bruno
 

brunounours

XLDnaute Nouveau
Re : Une macro ouvrant la fenêtre " Imprimer "

J'ai trouvé une solution à ce probleme.

En utilisant le debug pas à pas (touche F8) je me suis rendu compte que le problème ne venait pas du lancement des Userforms mais de leur contenu.

En effet, j'ai simplement eu a rajouter des
Code:
.value
apres chaque
Code:
.additem
qui existait dans mon code des Userforms.

Bruno.
 

Discussions similaires

Statistiques des forums

Discussions
312 488
Messages
2 088 859
Membres
103 978
dernier inscrit
bderradji