Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" <kapsnospaeem@wanadoo.fr> a écrit dans le message de news: OpLQJujxEHA.824@TK2MSFTNGP11.phx.gbl...
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
j'ai cru un moment qu'inspirée par LeSteph, tu t'étais mise à l'espagnol,
flo...
jps
"Misange" a écrit dans le message de
news:
C'est dans ma liste des todo
j'ai cru un moment qu'inspirée par LeSteph, tu t'étais mise à l'espagnol,
flo...
jps
"Misange" <misange@devinez-ou.net> a écrit dans le message de
news:OsFLcrlxEHA.2936@TK2MSFTNGP10.phx.gbl...
C'est dans ma liste des todo
j'ai cru un moment qu'inspirée par LeSteph, tu t'étais mise à l'espagnol,
flo...
jps
"Misange" a écrit dans le message de
news:
C'est dans ma liste des todo
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" <kapsnospaeem@wanadoo.fr> a écrit dans le message de news:
OpLQJujxEHA.824@TK2MSFTNGP11.phx.gbl...
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" <kapsnospaeem@wanadoo.fr> a écrit dans le message de news:
OpLQJujxEHA.824@TK2MSFTNGP11.phx.gbl...
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures (function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
Si tu as une erreur de compilation, c'est qu'il y a une erreur de syntaxe
... ou une longue ligne de code n'est pas
coupée de la bonne manière ... mais cela n'invalide pas la capacité de la
procédure à faire le travail.
Est-ce que les API ont été déclaré dans le haut du module ?
As-tu des lignes "Rouges" dans les API ? = coupure de la ligne incorrecte
!
Utilise la touche F8 et exécute la procédure Pas à Pas. Peut être qu'excel
te pointera là où le bât blesse !
Ceci étant dit, je n'ai aucune idée à savoir si cette même procure est
application dans son intégrité à tous les
systèmes d'exploitation !
Testé sous windows xp pro et excel 2002
Salutations!
"Eric" a écrit dans le message de news:
%
Bonjour Michdenis,
Merci de ta réponse, cependant cela ne fonctionne pas. J'ai recopié le
contenu de ton message dans un nouveau module.
Quand je complète
Sub ChangeImprimanteParDéfaut(Nom as String)
par
Sub ChangeImprimanteParDéfaut("Acrobat Distiller") 'imprimante fichier
ou Sub ChangeImprimanteParDéfaut("Xerox sur XEROX") 'Imprimante réseau
J'ai un message "Erreur de compilation" et pourtant les noms des
imprimantes
sont conforme au nom figurant dans le panneau de configuration
Pour info je suis sous W2K + Office 2002
Eric
"michdenis" a écrit dans le message de
news:Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures
(function
et sub)Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de
définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer
la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la
fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit
directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne
pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
Si tu as une erreur de compilation, c'est qu'il y a une erreur de syntaxe
... ou une longue ligne de code n'est pas
coupée de la bonne manière ... mais cela n'invalide pas la capacité de la
procédure à faire le travail.
Est-ce que les API ont été déclaré dans le haut du module ?
As-tu des lignes "Rouges" dans les API ? = coupure de la ligne incorrecte
!
Utilise la touche F8 et exécute la procédure Pas à Pas. Peut être qu'excel
te pointera là où le bât blesse !
Ceci étant dit, je n'ai aucune idée à savoir si cette même procure est
application dans son intégrité à tous les
systèmes d'exploitation !
Testé sous windows xp pro et excel 2002
Salutations!
"Eric" <kapsnospaeem@wanadoo.fr> a écrit dans le message de news:
%23Lk1F8lxEHA.3840@tk2msftngp13.phx.gbl...
Bonjour Michdenis,
Merci de ta réponse, cependant cela ne fonctionne pas. J'ai recopié le
contenu de ton message dans un nouveau module.
Quand je complète
Sub ChangeImprimanteParDéfaut(Nom as String)
par
Sub ChangeImprimanteParDéfaut("Acrobat Distiller") 'imprimante fichier
ou Sub ChangeImprimanteParDéfaut("Xerox sur XEROX") 'Imprimante réseau
J'ai un message "Erreur de compilation" et pourtant les noms des
imprimantes
sont conforme au nom figurant dans le panneau de configuration
Pour info je suis sous W2K + Office 2002
Eric
ehumeau.cgacaAVIRER@wanadoo.fr
"michdenis" <michdenis@hotmail.com> a écrit dans le message de
news:OT2Z6SlxEHA.3276@TK2MSFTNGP15.phx.gbl...
Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures
(function
et sub)
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" <kapsnospaeem@wanadoo.fr> a écrit dans le message de news:
OpLQJujxEHA.824@TK2MSFTNGP11.phx.gbl...
Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de
définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer
la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la
fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit
directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne
pas
tout le temps.
D'avance merci
Eric
Bonjour Éric,
Si tu as une erreur de compilation, c'est qu'il y a une erreur de syntaxe
... ou une longue ligne de code n'est pas
coupée de la bonne manière ... mais cela n'invalide pas la capacité de la
procédure à faire le travail.
Est-ce que les API ont été déclaré dans le haut du module ?
As-tu des lignes "Rouges" dans les API ? = coupure de la ligne incorrecte
!
Utilise la touche F8 et exécute la procédure Pas à Pas. Peut être qu'excel
te pointera là où le bât blesse !
Ceci étant dit, je n'ai aucune idée à savoir si cette même procure est
application dans son intégrité à tous les
systèmes d'exploitation !
Testé sous windows xp pro et excel 2002
Salutations!
"Eric" a écrit dans le message de news:
%
Bonjour Michdenis,
Merci de ta réponse, cependant cela ne fonctionne pas. J'ai recopié le
contenu de ton message dans un nouveau module.
Quand je complète
Sub ChangeImprimanteParDéfaut(Nom as String)
par
Sub ChangeImprimanteParDéfaut("Acrobat Distiller") 'imprimante fichier
ou Sub ChangeImprimanteParDéfaut("Xerox sur XEROX") 'Imprimante réseau
J'ai un message "Erreur de compilation" et pourtant les noms des
imprimantes
sont conforme au nom figurant dans le panneau de configuration
Pour info je suis sous W2K + Office 2002
Eric
"michdenis" a écrit dans le message de
news:Bonjour Éric,
IL y a une toute petite erreur sur le site de Misange à propos de la
fonction et de la procédure.
Dans cette ligne de code que l'on retrouve dans les 2 procédures
(function
et sub)Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
On se doit d'insérer un "" avant le "Win.ini" comme ceci :
Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) +
"win.ini"
Section API à déclarer dans le haut du module :
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
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
'------------------------------
Sub PourLancerLaProcédureImPrimanteParDéfaut()
'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")
End Sub
'------------------------------
Et ça roule !
Salutations!
"Eric" a écrit dans le message de news:Bonjour,
Sur l'excellent site excelabo, j'ai trouvé une macro permettant de
définir
l'imprimante par défaut de Windows
http://www.excelabo.net/xl/imprimer.php#piloterimprimante
J'ai un problème qui doit être tout bête, mais je n'arrive pas à lancer
la
macro Sub ChangeImprimanteParDéfaut(Nom As String)
Par quoi faut-il remplacer le (Nom as string) ?
Ce que je souhaite faire, c'est forcer le changement d'imprimante à la
fin
de ma macro (qui entres autres, pilote word et une autre appli en
automation) . Celle proposée semble me convenir car elle agit
directement
sur Windows et non pas seulement sur XL.
En effet, Application.ActivePrinter = "machin sur NExx" ne fonctionne
pas
tout le temps.
D'avance merci
Eric
