Comment définir la zone d'impression par VBA ?
Public Function Zone_Imp(ByRef HautGauche As String, ByRef ColDroite As String,
ByRef NrLigne As Integer) As Boolean
' cette procedure determine une zone d'impression
'syntaxe : etat!=Zone_Imp(string1,string2,nbl) /
Zone_Imp("A1","J",30)
'string1 = adresse de la cellule en haut à gauche du cadre ex :A1
'string2 = nom de la colonne à l'extreme droite du cadre ex : J
'Nbl = numero de la derniere ligne en bas du cadre ex : 30
'renvoie TRUE si tout c'est bien passé
On Error GoTo Erreur_Zone_Imp
Dim
BasDroite As String 'va contenir l'adresse de la cellule en bas à droite du cadre
Zone_Imp = False 'pour l'instant la zone n'est pas valide
BasDroite = ColDroite 'recuperer le nom de la colonne extreme droite
BasDroite = BasDroite + LTrim(Str$(NrLigne))
'creer l'adresse de la cellule en bas à droite du cadre
'version office 95
Range(HautGauche + ":" + BasDroite).Select 'selectionner la zone
ActiveSheet.PageSetup.PrintArea =Selection.Address
' version office 2000
'ActiveSheet.PageSetup.PrintArea = HautGauche + ":" + BasDroite '
"A1:J20"
valider la zone d'impression
Zone_Imp = True 'la fonction s'est bien deroulée
Exit Function
Erreur_Zone_Imp:
Zone_Imp = False 'la fonction a planté
End Function
ByRef NrLigne As Integer) As Boolean
' cette procedure determine une zone d'impression
'syntaxe : etat!=Zone_Imp(string1,string2,nbl) /
Zone_Imp("A1","J",30)
'string1 = adresse de la cellule en haut à gauche du cadre ex :A1
'string2 = nom de la colonne à l'extreme droite du cadre ex : J
'Nbl = numero de la derniere ligne en bas du cadre ex : 30
'renvoie TRUE si tout c'est bien passé
On Error GoTo Erreur_Zone_Imp
Dim
BasDroite As String 'va contenir l'adresse de la cellule en bas à droite du cadre
Zone_Imp = False 'pour l'instant la zone n'est pas valide
BasDroite = ColDroite 'recuperer le nom de la colonne extreme droite
BasDroite = BasDroite + LTrim(Str$(NrLigne))
'creer l'adresse de la cellule en bas à droite du cadre
'version office 95
Range(HautGauche + ":" + BasDroite).Select 'selectionner la zone
ActiveSheet.PageSetup.PrintArea =Selection.Address
' version office 2000
'ActiveSheet.PageSetup.PrintArea = HautGauche + ":" + BasDroite '
"A1:J20"
valider la zone d'impression
Zone_Imp = True 'la fonction s'est bien deroulée
Exit Function
Erreur_Zone_Imp:
Zone_Imp = False 'la fonction a planté
End Function
Eric Rbt,
Ajouté ou modifié le 20/01/2001 (N°957)
Ajouté ou modifié le 20/01/2001 (N°957)
Quelles sont les instructions permettant de piloter une imprimante par VBA ?
La fonction Imprimantes() renvoie un tableau contenant les noms de toutes
les imprimantes installées, en local ou sur réseau. Si aucune imprimante n'est
installée, elle renvoie la valeur Empty. La procédure Test place le
résultat de cette fonction dans une variable et copie son contenu dans une
feuille d'un nouveau classeur.
Note : pour faire sélectionner par l'utilisateur l'imprimante active, on
peut recourir à la boîte de dialogue PrinterSetup :
Application.Dialogs(xlDialogPrinterSetup).Show
MsgBox "Imprimante sélectionnée : " &
ActivePrinter
--------------------------------------------------------------------------
Private Declare Function EnumPrintersA Lib "Winspool.drv" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32" _
(ByVal lpString As Any) As Long
Private Declare Function lstrcpyA Lib "Kernel32" _
(ByVal lpString1 As String, ByVal lpString2 As Long) As Long
'____________________________________________________________
Private
Function Imprimantes()
Dim PrinterEnum() As Long, Impr() As String
Dim Needed As Long, Returned As Long, I As Integer
EnumPrintersA 2,
vbNullString, 5, 0, 0, Needed, 0
If Needed = 0 Then Exit Function
ReDim PrinterEnum(Needed / 4)
EnumPrintersA 2, vbNullString, 5, PrinterEnum(0), Needed, Needed, Returned
ReDim Impr(1 To Returned)
For I = 1 To Returned
Impr(I) = Space$(lstrlenA(PrinterEnum(I * 5 - 5)))
lstrcpyA Impr(I),
PrinterEnum(I * 5 - 5)
Next I
Imprimantes = Impr
End Function
____________________________________________________________
Sub Test()
'Place la liste des imprimantes installées dans la variable Impr
' et copie son contenu dans une feuille d'un nouveau classeur
Dim Impr
Impr =Imprimantes
If IsEmpty(Impr) Then
MsgBox "Aucune imprimante n'est installée.", vbCritical
Else
Application.ScreenUpdating = False
Workbooks.Add
With Range("A1").Resize(UBound(Impr))
.Value = WorksheetFunction.Transpose(Impr)
.Sort [A1]
End With
Columns(1).AutoFit
End If
End Sub
*****************************************************************
Puis le code qui suit permet, en VBA comme en VB, de retrouver et de changer
l'imprimante par défaut de Windows:
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
'------------------------------
les imprimantes installées, en local ou sur réseau. Si aucune imprimante n'est
installée, elle renvoie la valeur Empty. La procédure Test place le
résultat de cette fonction dans une variable et copie son contenu dans une
feuille d'un nouveau classeur.
Note : pour faire sélectionner par l'utilisateur l'imprimante active, on
peut recourir à la boîte de dialogue PrinterSetup :
Application.Dialogs(xlDialogPrinterSetup).Show
MsgBox "Imprimante sélectionnée : " &
ActivePrinter
--------------------------------------------------------------------------
Private Declare Function EnumPrintersA Lib "Winspool.drv" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenA Lib "Kernel32" _
(ByVal lpString As Any) As Long
Private Declare Function lstrcpyA Lib "Kernel32" _
(ByVal lpString1 As String, ByVal lpString2 As Long) As Long
'____________________________________________________________
Private
Function Imprimantes()
Dim PrinterEnum() As Long, Impr() As String
Dim Needed As Long, Returned As Long, I As Integer
EnumPrintersA 2,
vbNullString, 5, 0, 0, Needed, 0
If Needed = 0 Then Exit Function
ReDim PrinterEnum(Needed / 4)
EnumPrintersA 2, vbNullString, 5, PrinterEnum(0), Needed, Needed, Returned
ReDim Impr(1 To Returned)
For I = 1 To Returned
Impr(I) = Space$(lstrlenA(PrinterEnum(I * 5 - 5)))
lstrcpyA Impr(I),
PrinterEnum(I * 5 - 5)
Next I
Imprimantes = Impr
End Function
____________________________________________________________
Sub Test()
'Place la liste des imprimantes installées dans la variable Impr
' et copie son contenu dans une feuille d'un nouveau classeur
Dim Impr
Impr =Imprimantes
If IsEmpty(Impr) Then
MsgBox "Aucune imprimante n'est installée.", vbCritical
Else
Application.ScreenUpdating = False
Workbooks.Add
With Range("A1").Resize(UBound(Impr))
.Value = WorksheetFunction.Transpose(Impr)
.Sort [A1]
End With
Columns(1).AutoFit
End If
End Sub
*****************************************************************
Puis le code qui suit permet, en VBA comme en VB, de retrouver et de changer
l'imprimante par défaut de Windows:
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
'------------------------------
HD, (N°956)
J'aimerais imprimer une feuille à heure fixe, par exemple à 6h45...
Dans ton classeur, ouvre l'éditeur Visual Basic, insère un nouveau module et
copie le code suivant :
Sub Programme_le_réveil()
' lance la_macro_qui_imprime à 06h45 heures
Application.OnTime TimeValue("06:45:00"),
"La_macro_qui_imprime", True
End Sub
Sub La_Macro_qui_imprime()
'cette macro imprime la feuille Feuil1
ThisWorkbook.Sheets("Feuil1").PrintOut
' ou, si on est certain que la feuille à imprimer est la feuille active :
Activesheet.PrintOut
End Sub
Pour lancer le processus, il te suffit
d'exécuter une fois la macro Programme_le_réveil.
Cela fonctionnera tant que le classeur sera ouvert
copie le code suivant :
Sub Programme_le_réveil()
' lance la_macro_qui_imprime à 06h45 heures
Application.OnTime TimeValue("06:45:00"),
"La_macro_qui_imprime", True
End Sub
Sub La_Macro_qui_imprime()
'cette macro imprime la feuille Feuil1
ThisWorkbook.Sheets("Feuil1").PrintOut
' ou, si on est certain que la feuille à imprimer est la feuille active :
Activesheet.PrintOut
End Sub
Pour lancer le processus, il te suffit
d'exécuter une fois la macro Programme_le_réveil.
Cela fonctionnera tant que le classeur sera ouvert
Thomas Corvaisier, (N°955)
Est il possible (en VB) de changer l'imprimante par défaut de Windows
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
'------------------------------
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
'------------------------------
Jean Marie Pierrard, (N°954)
Quels sont les codes VBA relatifs à l'impression ?
Pour définir une zone d'impression :
ActiveSheet.PageSetup.PrintArea = "A1:$K$36"
pour supprimer une zone d'impression :
ActiveSheet.PageSetup.PrintArea = ""
pour insérer un saut de page horizontal :
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Pour insérer un saut de page vertical :
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=ActiveCell
ActiveSheet.PageSetup.PrintArea = "A1:$K$36"
pour supprimer une zone d'impression :
ActiveSheet.PageSetup.PrintArea = ""
pour insérer un saut de page horizontal :
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Pour insérer un saut de page vertical :
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=ActiveCell
Microsoft, (N°953)
Je dois faire une application qui fonctionne sur plusieurs postes A un moment donné je dois
sélectionner l'imprimante "Epson Stylus Color 760" par exemple... Le problème, c'est
que sur un poste, ce sera : application.activeprinter = "Epson Stylus Color 760 sur
LTP1" alors que sur un autre ce sera quelque chose du genre : application.activeprinter =
"Epson Stylus Color 760 on \adresseserveur
omdel'imprimantepartagée" Comment faire
pour tester chaque imprimante du systeme et tester le debut de la chaine (pour activer cette
imprimante quel que soit son port) ?
Cette macro liste les imprimantes, donne le choix et le nombre de pages à imprimer.
Sub Imprime()
Dim BookName As string
BookName = Workbooks("Machin.xls")
If Not Printer_Choice(BookName) Then Workbooks(BookName).Sheet(1).PrintOut
copies:=1
End Sub
'Sélection imprimante pour impression
Function Printer_Choice(nBook As String) As Boolean
Const msgPart1 = " page(s) à imprimer sur "
Const msgPart2 = "Imprimante active :"
Const msgPart3 = "Voulez-vous changer d'imprimante ?"
Dim Reply As Byte, Actual_Printer As String, nbPages As String
If Not nBook = "" Then
Workbooks(nBook).Activate
nbPages = ExecuteExcel4Macro("GET.DOCUMENT(50)") & msgPart1
End If
Actual_Printer = Application.ActivePrinter
Reply = MsgBox(nbPages & msgPart2 & vbLf & Actual_Printer & " !" & vbLf &
vbLf & msgPart3 _
, 3 + 32 + 256, "Info utilisateur")
If Reply = vbYes Then Application.Dialogs(xlDialogPrinterSetup).Show
If Reply = vbCancel Then Printer_Choice = True
End Function
Sub Imprime()
Dim BookName As string
BookName = Workbooks("Machin.xls")
If Not Printer_Choice(BookName) Then Workbooks(BookName).Sheet(1).PrintOut
copies:=1
End Sub
'Sélection imprimante pour impression
Function Printer_Choice(nBook As String) As Boolean
Const msgPart1 = " page(s) à imprimer sur "
Const msgPart2 = "Imprimante active :"
Const msgPart3 = "Voulez-vous changer d'imprimante ?"
Dim Reply As Byte, Actual_Printer As String, nbPages As String
If Not nBook = "" Then
Workbooks(nBook).Activate
nbPages = ExecuteExcel4Macro("GET.DOCUMENT(50)") & msgPart1
End If
Actual_Printer = Application.ActivePrinter
Reply = MsgBox(nbPages & msgPart2 & vbLf & Actual_Printer & " !" & vbLf &
vbLf & msgPart3 _
, 3 + 32 + 256, "Info utilisateur")
If Reply = vbYes Then Application.Dialogs(xlDialogPrinterSetup).Show
If Reply = vbCancel Then Printer_Choice = True
End Function
Michel Pierron, (N°952)