Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Re:imprimer formulaire mais en format paysage

Re:imprimer formulaire mais en format paysage

4 réponses
Avatar
jil
Bonjour à tous,

>Je voudrais imprimer, en format paysage et en brouillon, un formulaire
>affiché à l'écran.L'impression se fait à partir d'un bouton sur ce
>formulaire.

Michel Pierron m'a gentiment indiqué ce code mais je n'arrive pas à le
faire fonctionner. Je ne sais pas trop si tout le code ce met dans le code
du formulaire ou une partie seulement et l'autre en module ou module de
classe. Je suis un peu perdue. Merci pour votre aide.

> Option Explicit
> Private Type OSVERSIONINFO
> dwOSVersionInfoSize As Long
> dwMajorVersion As Long
> dwMinorVersion As Long
> dwBuildNumber As Long
> dwPlatformId As Long
> szCSDVersion As String * 128
> End Type
> Private Declare Function GetVersionEx& Lib _
> "kernel32" Alias "GetVersionExA" _
> (lpVersionInformation As OSVERSIONINFO)
> Private Declare Sub keybd_event Lib "user32" _
> (ByVal bVk As Byte, ByVal bScan As Byte _
> , ByVal dwFlags&, ByVal dwExtraInfo&)
> Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
> Private Declare Function EmptyClipboard& Lib "user32" ()
> Private Declare Function CloseClipboard& Lib "user32" ()
> Private Const KEYEVENTF_KEYUP = &H2
> Private Const VK_SNAPSHOT = &H2C
> Private Const VK_MENU = &H12
>
> ' Impression écran en paysage
> Private Sub CommandButton1_Click()
> Me.Repaint
> OpenClipboard 0&
> EmptyClipboard
> Dim OSI As OSVERSIONINFO
> OSI.dwOSVersionInfoSize = 148
> OSI.szCSDVersion = Space$(128)
> Call GetVersionEx(OSI)
> If OSI.dwMajorVersion > 4 Then
> keybd_event VK_SNAPSHOT, 1, 0, 0
> Else
> keybd_event VK_MENU, 0, 0, 0
> keybd_event VK_SNAPSHOT, 0, 0, 0
> keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
> keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
> End If
> CloseClipboard
> DoEvents
> Application.ScreenUpdating = False
> Dim NewBook As String
> Workbooks.Add: ActiveSheet.Paste
> NewBook = ActiveWorkbook.Name
> With ActiveSheet.PageSetup
> .RightFooter = Me.Caption & " Le &D Page &P/&N"
> .PrintGridlines = False
> .Orientation = xlLandscape
> .PaperSize = xlPaperA4
> .Zoom = False
> .FitToPagesWide = 1
> .FitToPagesTall = False
> End With
> ActiveWindow.Visible = False
> Application.ScreenUpdating = True
> Me.Hide
> On Error Resume Next
> Windows(NewBook).SelectedSheets.PrintOut Copies:=1
> Workbooks(NewBook).Close False
> Me.Show
> End Sub

Jil
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
pirot
bonjour,

j'ai le problème suivant:

Une table ELEVE d'une bd access contient les n° élève puis nom prénom,
classe


Dans une cellule d'une feuille EXCEL je place le n°élève (en A1 par
exemple).

Quelle est la fonction (ou code VBA ?) qui en B1 donne le nom, en C1 le
prénom en D1 la classe de l'élève lu directement à partir de la table
ACCESS (sans créer une feuille access avec tous les élèves) ?

merci de vos réponses, ou d'un lien vers un site qui pourrait m'aider.

pirot.
Avatar
michdenis
Bonjour Pirot,

Voici un exemple complet du code que tu pourrais retrouver dans
le module feuille où l'action se déroule :

Tu dois charger la bibliothèque suivante :
"Microsoft DAO 3.6 Objects librairy"

'Déclaration des variables dans le haut du module de la feuille
Dim Db As Database, RstTrouve As Recordset
'.---------------------------------------
Private Sub Worksheet_Activate()
'Dès que la feuille est sélectionné...
'Ouverture de la base de données à adapter
Set Db = OpenDatabase("C:ATravailAccess exempledb1.mdb")
'ouverture du recordset - la table "édudiant"
Set RstTrouve = Db.OpenRecordset("toto", dbOpenDynaset)

End Sub
'.---------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim C As Range, Rg As Range
Dim Chaine As Variant

Set Rg = Intersect(Target, Columns(1))
If Not Rg Is Nothing Then
For Each C In Rg
If C <> "" Then
'Le contenu de la cellule sert de critère de recherche
Chaine = Trim(C.Value)
With RstTrouve
'[Num] = NOm du champ(clé primaire) àpartir
'duquel on essaie de trouver un enregistrement.
'Si la recherche est du texte
'.FindFirst "[Num] = " & Chr(34) & Chaine & Chr(34)
.FindFirst "[Num] = " & Chaine

If .NoMatch = False Then
'la colonne à droite de la cellule
'ayant de critère recevra la valeur du champ 1
'à droite du champ de la clé primaire
C(, 2) = RstTrouve(1)
Else
C(, 2) = ""
End If
End With
End If
Next
End If
Set Rg = Nothing: Set C = Nothing

End Sub
'.---------------------------------------
Private Sub Worksheet_Deactivate()
On Error Resume Next
Rst.Close: Db.Close
Set Db = Nothing: Set RstTrouve = Nothing
End Sub
'.---------------------------------------

Et dans le ThisWorkbook :
'---------------------------------------
Private Sub Workbook_Activate()

'Feuil2 = codename de l'objet feuille
If ActiveSheet.CodeName = Feuil2.Name Then
Feuil2.Activate
End If

End Sub
'---------------------------------------



Salutations!




"pirot" a écrit dans le message de news: 43c6b15d$0$27955$
bonjour,

j'ai le problème suivant:

Une table ELEVE d'une bd access contient les n° élève puis nom prénom,
classe


Dans une cellule d'une feuille EXCEL je place le n°élève (en A1 par
exemple).

Quelle est la fonction (ou code VBA ?) qui en B1 donne le nom, en C1 le
prénom en D1 la classe de l'élève lu directement à partir de la table
ACCESS (sans créer une feuille access avec tous les élèves) ?

merci de vos réponses, ou d'un lien vers un site qui pourrait m'aider.

pirot.
Avatar
Michel Pierron
Bonsoir jil;
Colle l'ensemble du code dans le module de ton UserForm; le bouton
CommandButton1 correspond à ton bouton d'impression. As tu bien reporté le
code tel que mentionné (il suffit de faire un copier-coller).

Tu peux tester l'absence d'erreur en le compilant (Menu Debogage / Compiler
VBAProject).

MP

"jil" a écrit dans le message de news:
eIO$
Bonjour à tous,

Je voudrais imprimer, en format paysage et en brouillon, un formulaire
affiché à l'écran.L'impression se fait à partir d'un bouton sur ce
formulaire.


Michel Pierron m'a gentiment indiqué ce code mais je n'arrive pas à le
faire fonctionner. Je ne sais pas trop si tout le code ce met dans le code
du formulaire ou une partie seulement et l'autre en module ou module de
classe. Je suis un peu perdue. Merci pour votre aide.

Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx& Lib _
"kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO)
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte _
, ByVal dwFlags&, ByVal dwExtraInfo&)
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function EmptyClipboard& Lib "user32" ()
Private Declare Function CloseClipboard& Lib "user32" ()
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

' Impression écran en paysage
Private Sub CommandButton1_Click()
Me.Repaint
OpenClipboard 0&
EmptyClipboard
Dim OSI As OSVERSIONINFO
OSI.dwOSVersionInfoSize = 148
OSI.szCSDVersion = Space$(128)
Call GetVersionEx(OSI)
If OSI.dwMajorVersion > 4 Then
keybd_event VK_SNAPSHOT, 1, 0, 0
Else
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End If
CloseClipboard
DoEvents
Application.ScreenUpdating = False
Dim NewBook As String
Workbooks.Add: ActiveSheet.Paste
NewBook = ActiveWorkbook.Name
With ActiveSheet.PageSetup
.RightFooter = Me.Caption & " Le &D Page &P/&N"
.PrintGridlines = False
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Me.Hide
On Error Resume Next
Windows(NewBook).SelectedSheets.PrintOut Copies:=1
Workbooks(NewBook).Close False
Me.Show
End Sub


Jil





Avatar
jil
Bonsoir Michel,

Effectivement cela fonctionne! je pensais bêtement que la première partie de
ton code ne se mettait pas dans le module du formulaire mais en module de
classe!! Comme quoi, on se complique la vie pour rien des fois.

Par contre, visiblement on passe par une copie d'écran que l'on imprime? Le
problème, c'est que mon formulaire en hauteur il fait 400, donc il est au
moins en 2 pages. La copie d'écran, et c'est logique ne prend pas mon pied
de formulaire...Existe t-il un moyen pour l'imprimer en entier?

Merci pour tes lumières
Jil


"Michel Pierron" a écrit dans le message de news:

Bonsoir jil;
Colle l'ensemble du code dans le module de ton UserForm; le bouton
CommandButton1 correspond à ton bouton d'impression. As tu bien reporté le
code tel que mentionné (il suffit de faire un copier-coller).

Tu peux tester l'absence d'erreur en le compilant (Menu Debogage /
Compiler

VBAProject).

MP

"jil" a écrit dans le message de news:
eIO$
Bonjour à tous,

Je voudrais imprimer, en format paysage et en brouillon, un formulaire
affiché à l'écran.L'impression se fait à partir d'un bouton sur ce
formulaire.


Michel Pierron m'a gentiment indiqué ce code mais je n'arrive pas à le
faire fonctionner. Je ne sais pas trop si tout le code ce met dans le
code


du formulaire ou une partie seulement et l'autre en module ou module de
classe. Je suis un peu perdue. Merci pour votre aide.

Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx& Lib _
"kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVERSIONINFO)
Private Declare Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte _
, ByVal dwFlags&, ByVal dwExtraInfo&)
Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function EmptyClipboard& Lib "user32" ()
Private Declare Function CloseClipboard& Lib "user32" ()
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

' Impression écran en paysage
Private Sub CommandButton1_Click()
Me.Repaint
OpenClipboard 0&
EmptyClipboard
Dim OSI As OSVERSIONINFO
OSI.dwOSVersionInfoSize = 148
OSI.szCSDVersion = Space$(128)
Call GetVersionEx(OSI)
If OSI.dwMajorVersion > 4 Then
keybd_event VK_SNAPSHOT, 1, 0, 0
Else
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End If
CloseClipboard
DoEvents
Application.ScreenUpdating = False
Dim NewBook As String
Workbooks.Add: ActiveSheet.Paste
NewBook = ActiveWorkbook.Name
With ActiveSheet.PageSetup
.RightFooter = Me.Caption & " Le &D Page &P/&N"
.PrintGridlines = False
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveWindow.Visible = False
Application.ScreenUpdating = True
Me.Hide
On Error Resume Next
Windows(NewBook).SelectedSheets.PrintOut Copies:=1
Workbooks(NewBook).Close False
Me.Show
End Sub


Jil