Renvoyer le nom de chaque personne ayant un statut défini
Bonjour à tous,
Je suis nouveau sur le forum. Je m'appelle Raphaël et suis en 5ème année d'école d'ingénieur en apprentissage avec une entreprise qui fabrique de beaux avions dans le sud ouest de la France.
Je travaille actuellement sur le developpement d'un fichier Excel en vue d'améliorer l'interface à l'aide de plusieurs Userforms. Cependant, je n'ai jamais été formé à VBA et rencontre quelques soucis pour la syntaxe. Jusque là, j'ai toujours réussi à me débrouiller en modifiant des codes existant sur le net, j'ai donc appris sur le tas. Mais aujourd'hui, je bloque vraiment.
Voici mon problème :
Depuis la feuille "Fiches", en cliquant sur un bouton, un Userform apparait me permettant de rentrer les données personnelles, le statut de la personne, plusieurs dates, des zones de textes... Quand je clique sur Enregistrer, toutes les données remplies dans l'Userform s'insère à l'endroit voulu dans la feuille "Fiches". Sur d'autres feuilles apparait des graphiques. Sur l'un d'entres eux, j'ai un diagramme en barres horizontales qui montrent la repartition des personnes suivant le statut. J'aimerai sur cette feuille, insérer un bouton "Imprimer". Celui-ci imprimerait tous les Userforms des personnes ayant le statut "En cours" ou "Critique". J'ai donc écris :
Private Sub ComboBox23_Change()
With Sheets("Fiches")
Dim Statut As Variant 'variable pour ma boucle For each
Dim Nom As Integer 'variable pour remplir la Combobox23 là où se trouve le Nom de la personne
Dim lign1 As Long 'variable pour detecter la dernière ligne de la colonne date de création
Dim lign2 As Long
Dim lign3 As Long
Dim lign4 As Long
Dim lign5 As Long
Dim lign As Long 'variable pour detecter la dernière ligne
lign1 = Worksheets("Fiches").Range("a65536").End(xlUp).Row 'colonne date de création
lign2 = Worksheets("Fiches").Range("i65536").End(xlUp).Row 'colonne type de restrictions
lign3 = Worksheets("Fiches").Range("j65536").End(xlUp).Row 'colonne la restriction
lign4 = Worksheets("Fiches").Range("k65536").End(xlUp).Row 'colonne commentaire
lign5 = Worksheets("Fiches").Range("l65536").End(xlUp).Row 'colonne actions réalisées
lign = Application.WorksheetFunction.Max(lign1, lign2, lign3, lign4, lign5)
For Each Statut In Range("B3:B100") 'les statut se trouve dans la colonne 2 à partir de la 3ème ligne
If Statut.Row < lign.Value Then 'je demande que pour chaque ligne au dessus de la dernière ligne
If Statut = "En cours" Or Statut = "Critique" Then 'si les statuts sont en cours ou critique
Nom = Sheets("Fiches").Cells.Find(what:=Statut, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlNext).Row 'je detecte la ligne correpondant aux lignes où il y a "En cours" ou Critique" que j'ai appelé "Nom" pour la suite de mon code
ComboBox23 = Cells(Nom, 3).Value 'je remplie dans la combobox23 la valeur qui se trouve dans la colonne 3 ligne "Nom"La suite du code correspond aux codes qui permet, suite au nom rempli dans la combobox23, de remplir tous les autres combobox, textbox ... de l'userform et imprime.
Le code du bouton "Imprimer" permet juste de lancer l'userform en question.
Je suis désolé si ce n'est pas trés clair, j'aurai aimé vous joindre le fichier mais je ne sais pas si j'ai le droit pour des raisons de confidentialité. Si vous n'avez pas compris, n'hésitez pas à me poser des questions.
Je vous remercie par avance de l'aide que vous pouvez m'apporter.
A bientôt
Raphael
Bonjour Raphael.P et bienvenue,
C’est le fils d’un mécanicien de Sud-Aviation qui te salue (ce qui nous renvoie à quelques décennies).
A priori, tu n’as pas besoin de faire une recherche avec Find puisque tu balayes chaque ligne de données.
Voici un exemple de traitement.
A+
Bonjour frangy,
Un grand merci pour ton aide, en effet c'est beaucoup plus simple, et ça fonctionne !
Cependant, quand je l'adapte à mon fichier, j'ai une erreur d'incompatibilité 13 à la ligne : If Statut = "En cours" ou...
Private Sub Image2_Click()
Dim Statut As Variant
Dim Nom As Integer
Dim lign As Long
Dim Msg As String
With Sheets("Fiches")
lign = .Range("B" & Rows.Count).End(xlUp).Row
For Each Statut In Range("B3:B" & lign)
If Statut = "En cours" Or Statut = "Critique" Then 'le bug apparait ici
'Msg = Msg & "Statut " & Statut & " trouvé à la ligne " & Statut.Row & ". On renvoie " & Statut.Offset(0, 1) & Chr(10)
Nom = Statut.Offset(0, 1)
Load UserForm5
ComboBox23 = Nom
'Informations Générales
DTPicker1 = Range("C" & Nom).Offset(0, -2).Value
ComboBox4 = Range("C" & Nom).Offset(0, -1).Value
'Informations Personnelles
ComboBox24 = Range("C" & Nom).Offset(0, 1).Value
TextBox14 = Range("C" & Nom).Offset(0, 2).Value
ComboBox1 = Day(CDate(Range("F" & Nom).Value))
ComboBox2 = MonthName(Month(Range("F" & Nom).Value))
ComboBox3 = Year(CDate(Range("F" & Nom).Value))
ComboBox22 = Range("C" & Nom).Offset(0, 4).Value
TextBox15 = Range("C" & Nom).Offset(0, 5).Value
'1ère Restriction
ComboBox7 = Range("C" & Nom).Offset(0, 6).Value
ComboBox8 = Range("C" & Nom).Offset(0, 7).Value
TextBox37 = Range("C" & Nom).Offset(0, 8).Value
'1er Commentaire - Actions Réalisées
If Range("C" & Nom).Offset(0, 9).Value = "" Then
Else
DTPicker2 = Range("C" & Nom).Offset(0, 9).Value
End If
If Range("C" & Nom).Offset(0, 10).Value = "" Then
Else
TextBox45 = Range("C" & Nom).Offset(0, 10).Value
End If
If Cells(Nom + 1, 3) = "" Then
'2ème Restriction
ComboBox10 = Range("C" & Nom + 1).Offset(0, 6).Value
ComboBox11 = Range("C" & Nom + 1).Offset(0, 7).Value
TextBox38 = Range("C" & Nom + 1).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 1).Offset(0, 9).Value = "" Then
Else
DTPicker3 = Range("C" & Nom + 1).Offset(0, 9).Value
End If
If Range("C" & Nom + 1).Offset(0, 10).Value = "" Then
Else
TextBox55 = Range("C" & Nom + 1).Offset(0, 10).Value
End If
If Cells(Nom + 2, 3) = "" Then
'3ème Restriction
ComboBox12 = Range("C" & Nom + 2).Offset(0, 6).Value
ComboBox13 = Range("C" & Nom + 2).Offset(0, 7).Value
TextBox39 = Range("C" & Nom + 2).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 2).Offset(0, 9).Value = "" Then
Else
DTPicker4 = Range("C" & Nom + 2).Offset(0, 9).Value
End If
If Range("C" & Nom + 2).Offset(0, 10).Value = "" Then
Else
TextBox57 = Range("C" & Nom + 2).Offset(0, 10).Value
End If
If Cells(Nom + 3, 3) = "" Then
'4ème Restriction
ComboBox14 = Range("C" & Nom + 3).Offset(0, 6).Value
ComboBox15 = Range("C" & Nom + 3).Offset(0, 7).Value
TextBox40 = Range("C" & Nom + 3).Offset(0, 8).Value
If Cells(Nom + 4, 3) = "" Then
'5ème Restriction
ComboBox16 = Range("C" & Nom + 4).Offset(0, 6).Value
ComboBox17 = Range("C" & Nom + 4).Offset(0, 7).Value
TextBox41 = Range("C" & Nom + 4).Offset(0, 8).Value
If Cells(Nom + 5, 3) = "" Then
'6ème Restriction
ComboBox18 = Range("C" & Nom + 5).Offset(0, 6).Value
ComboBox19 = Range("C" & Nom + 5).Offset(0, 7).Value
TextBox42 = Range("C" & Nom + 5).Offset(0, 8).Value
If Cells(Nom + 6, 3) = "" Then
'7ème Restriction
ComboBox20 = Range("C" & Nom + 6).Offset(0, 6).Value
ComboBox21 = Range("C" & Nom + 6).Offset(0, 7).Value
TextBox43 = Range("C" & Nom + 6).Offset(0, 8).Value
End If
End If
End If
End If
End If
End If
'Imprime
Application.ScreenUpdating = False
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
With ActiveSheet
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Activate
.PageSetup.Orientation = xlLandscape
.PageSetup.LeftMargin = Application.InchesToPoints(0)
.PageSetup.RightMargin = Application.InchesToPoints(0)
.PageSetup.TopMargin = Application.InchesToPoints(0.3)
.PageSetup.BottomMargin = Application.InchesToPoints(0)
.PageSetup.HeaderMargin = Application.InchesToPoints(0)
.PageSetup.FooterMargin = Application.InchesToPoints(0)
.PageSetup.PrintHeadings = False
.PageSetup.PrintGridlines = False
.PageSetup.PrintComments = xlPrintNoComments
.PageSetup.CenterHorizontally = True
.PageSetup.CenterVertically = True
.PageSetup.Draft = False
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Order = xlDownThenOver
.PageSetup.BlackAndWhite = False
.PageSetup.Zoom = 80
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End If
Next Statut
'MsgBox Msg
End With
End SubJe t'ai mis tout le code lié à ce que je veux faire si tu veux y jeté un coup d'oeil (il peut y avoir 7 Restrictions par personne), je pense que pour le reste il n'y a pas dérreur.
Merci d'avance !
Raphaël
J'ai modifié quelques lignes du code, et maintenant il bloque sur "Nom" en me disant "Qualificateur incorrect"
Private Sub Image2_Click()
Dim Statut As Variant
Dim Nom As Integer
Dim lign As Long
Dim Msg As String
With Sheets("Fiches")
lign = .Range("B" & Rows.Count).End(xlUp).Row
For Each Statut In Range("B3:B" & lign)
If Statut = "En cours" Or Statut = "Critique" Then
Nom = Statut.Offset(0, 1).Value
Load UserForm5
ComboBox23 = Nom.Value
'Informations Générales
DTPicker1 = Range("C" & Nom).Offset(0, -2).Value
ComboBox4 = Range("C" & Nom).Offset(0, -1).Value
'Informations Personnelles
ComboBox24 = Range("C" & Nom).Offset(0, 1).Value
TextBox14 = Range("C" & Nom).Offset(0, 2).Value
ComboBox1 = Day(CDate(Range("F" & Nom).Value))
ComboBox2 = MonthName(Month(Range("F" & Nom).Value))
ComboBox3 = Year(CDate(Range("F" & Nom).Value))
ComboBox22 = Range("C" & Nom).Offset(0, 4).Value
TextBox15 = Range("C" & Nom).Offset(0, 5).Value
'1ère Restriction
ComboBox7 = Range("C" & Nom).Offset(0, 6).Value
ComboBox8 = Range("C" & Nom).Offset(0, 7).Value
TextBox37 = Range("C" & Nom).Offset(0, 8).Value
'1er Commentaire - Actions Réalisées
If Range("C" & Nom).Offset(0, 9).Value = "" Then
Else
DTPicker2 = Range("C" & Nom).Offset(0, 9).Value
End If
If Range("C" & Nom).Offset(0, 10).Value = "" Then
Else
TextBox45 = Range("C" & Nom).Offset(0, 10).Value
End If
If Cells(Nom + 1, 3) = "" Then
'2ème Restriction
ComboBox10 = Range("C" & Nom + 1).Offset(0, 6).Value
ComboBox11 = Range("C" & Nom + 1).Offset(0, 7).Value
TextBox38 = Range("C" & Nom + 1).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 1).Offset(0, 9).Value = "" Then
Else
DTPicker3 = Range("C" & Nom + 1).Offset(0, 9).Value
End If
If Range("C" & Nom + 1).Offset(0, 10).Value = "" Then
Else
TextBox55 = Range("C" & Nom + 1).Offset(0, 10).Value
End If
If Cells(Nom + 2, 3) = "" Then
'3ème Restriction
ComboBox12 = Range("C" & Nom + 2).Offset(0, 6).Value
ComboBox13 = Range("C" & Nom + 2).Offset(0, 7).Value
TextBox39 = Range("C" & Nom + 2).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 2).Offset(0, 9).Value = "" Then
Else
DTPicker4 = Range("C" & Nom + 2).Offset(0, 9).Value
End If
If Range("C" & Nom + 2).Offset(0, 10).Value = "" Then
Else
TextBox57 = Range("C" & Nom + 2).Offset(0, 10).Value
End If
If Cells(Nom + 3, 3) = "" Then
'4ème Restriction
ComboBox14 = Range("C" & Nom + 3).Offset(0, 6).Value
ComboBox15 = Range("C" & Nom + 3).Offset(0, 7).Value
TextBox40 = Range("C" & Nom + 3).Offset(0, 8).Value
If Cells(Nom + 4, 3) = "" Then
'5ème Restriction
ComboBox16 = Range("C" & Nom + 4).Offset(0, 6).Value
ComboBox17 = Range("C" & Nom + 4).Offset(0, 7).Value
TextBox41 = Range("C" & Nom + 4).Offset(0, 8).Value
If Cells(Nom + 5, 3) = "" Then
'6ème Restriction
ComboBox18 = Range("C" & Nom + 5).Offset(0, 6).Value
ComboBox19 = Range("C" & Nom + 5).Offset(0, 7).Value
TextBox42 = Range("C" & Nom + 5).Offset(0, 8).Value
If Cells(Nom + 6, 3) = "" Then
'7ème Restriction
ComboBox20 = Range("C" & Nom + 6).Offset(0, 6).Value
ComboBox21 = Range("C" & Nom + 6).Offset(0, 7).Value
TextBox43 = Range("C" & Nom + 6).Offset(0, 8).Value
End If
End If
End If
End If
End If
End If
'Imprime
Application.ScreenUpdating = False
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
With ActiveSheet
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Activate
.PageSetup.Orientation = xlLandscape
.PageSetup.LeftMargin = Application.InchesToPoints(0)
.PageSetup.RightMargin = Application.InchesToPoints(0)
.PageSetup.TopMargin = Application.InchesToPoints(0.3)
.PageSetup.BottomMargin = Application.InchesToPoints(0)
.PageSetup.HeaderMargin = Application.InchesToPoints(0)
.PageSetup.FooterMargin = Application.InchesToPoints(0)
.PageSetup.PrintHeadings = False
.PageSetup.PrintGridlines = False
.PageSetup.PrintComments = xlPrintNoComments
.PageSetup.CenterHorizontally = True
.PageSetup.CenterVertically = True
.PageSetup.Draft = False
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Order = xlDownThenOver
.PageSetup.BlackAndWhite = False
.PageSetup.Zoom = 80
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Msg = Msg & "Les fiches suivantes ont été imprimées :" & Chr(10) & "-" & Nom & Nom.Offset(0, 1) & Chr(10)
End If
Next Statut
MsgBox Msg
End With
End SubJ'ai aussi essayé de rajouter un petit message à la fin comme toi pour dire quelles fiches avaient été imprimées
As-tu résolu le problème ?
Nom est déclaré nombre Entier.
Est-ce que la valeur de Statut.Offset(0, 1) est un entier ?
A+
Non Statut.Offset(0, 1) est le nom de famille, et Statut.Offset(0, 2) est un prénom.
Il faudrait que je rajoute une variable String alors je pense.
En fait, mon principal problème est que je ne sais pas du tout où placer le code. Je clic sur un bouton dans une feuille pour lancer l'Userform, puis l'USerform doit se débrouiller tout seul jusqu'a imprimer les fiches et me dire quelles fiches il a imprimer.
J'ai donc :
Private Sub Image2_Click()
Load UserForm5
End SubPuis mon code je dois le placer dans USerform_Activate ou Userform_Initialize ?
Aprés avoir tout touché, mon erreur imcomptibilité du type 13 est revenue sur la ligne
For Each Statut In Range("B3:B" & lign)Peut être vaudrait-il mieux que je joigne mon fichier quand meme ...
Voici mon fichier :
Pour créer une fiche, il faut cliquer sur Accées formulaire dans la feuille Fiches, puis sur Créer.
Vous pouvez modifier une fiche en cliquand sur modifier et en choisissant le nom de la personne.
J'aimerai maintenant, en cliquant sur le bouton imprimer de la feuille Statut, lancer l'userform5 et remplir puis imprimer toutes les personnes ayant le statut "En cours" ou "Critique".
J'ai placé le code que j'ai créé dans Userform_Activite mais rien ne fonctionne.
Restant à votre disposition.
Et merci d'avance pour les personnes voulant bien m'aider.
Raphael
Voici mon fichier
Attention que le fichier ne dépasse pas la limite autorisée.
For Each Statut In Range("B3:B" & lign)
On devrait voir un point avant Range afin d'indiquer que l'instruction fait référence à la feuille "Fiches"
For Each Statut In .Range("B3:B" & lign)
A+
En effet merci le problème eétait le .Range.
J'essaie de compresser le fichier je rencontre quelques souçis avec l'ordi du travail.
C'est bon j'ai trouvé ! J'avais plein de petites erreur de syntaxe mais tout fonctionne avec ce code :
Private Sub UserForm_Activate()
DTPicker1.Value = Date
DTPicker2.Value = Date
DTPicker3.Value = Date
DTPicker4.Value = Date
Frame4.BackColor = RGB(36, 64, 98)
Frame3.BackColor = RGB(36, 64, 98)
Frame2.BackColor = RGB(36, 64, 98)
Frame5.BackColor = RGB(36, 64, 98)
Dim Statut As Variant
Dim Nom As Integer
Dim lign As Long
Dim Msg As String
With Sheets("Fiches")
lign = .Range("B" & Rows.Count).End(xlUp).Row
For Each Statut In .Range("B3:B" & lign)
If Statut = "En cours" Or Statut = "Critique" Then
Nom = Statut.Row
ComboBox23 = Range("C" & Nom).Value
'Informations Générales
DTPicker1 = Range("C" & Nom).Offset(0, -2).Value
ComboBox4 = Range("C" & Nom).Offset(0, -1).Value
'Informations Personnelles
ComboBox24 = Range("C" & Nom).Offset(0, 1).Value
TextBox14 = Range("C" & Nom).Offset(0, 2).Value
ComboBox1 = Day(CDate(Range("F" & Nom).Value))
ComboBox2 = MonthName(Month(Range("F" & Nom).Value))
ComboBox3 = Year(CDate(Range("F" & Nom).Value))
ComboBox22 = Range("C" & Nom).Offset(0, 4).Value
TextBox15 = Range("C" & Nom).Offset(0, 5).Value
'1ère Restriction
ComboBox7 = Range("C" & Nom).Offset(0, 6).Value
ComboBox8 = Range("C" & Nom).Offset(0, 7).Value
TextBox37 = Range("C" & Nom).Offset(0, 8).Value
'1er Commentaire - Actions Réalisées
If Range("C" & Nom).Offset(0, 9).Value = "" Then
Else
DTPicker2 = Range("C" & Nom).Offset(0, 9).Value
End If
If Range("C" & Nom).Offset(0, 10).Value = "" Then
Else
TextBox45 = Range("C" & Nom).Offset(0, 10).Value
End If
If Cells(Nom + 1, 3) = "" Then
'2ème Restriction
ComboBox10 = Range("C" & Nom + 1).Offset(0, 6).Value
ComboBox11 = Range("C" & Nom + 1).Offset(0, 7).Value
TextBox38 = Range("C" & Nom + 1).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 1).Offset(0, 9).Value = "" Then
Else
DTPicker3 = Range("C" & Nom + 1).Offset(0, 9).Value
End If
If Range("C" & Nom + 1).Offset(0, 10).Value = "" Then
Else
TextBox55 = Range("C" & Nom + 1).Offset(0, 10).Value
End If
If Cells(Nom + 2, 3) = "" Then
'3ème Restriction
ComboBox12 = Range("C" & Nom + 2).Offset(0, 6).Value
ComboBox13 = Range("C" & Nom + 2).Offset(0, 7).Value
TextBox39 = Range("C" & Nom + 2).Offset(0, 8).Value
'2ème Commentaire - Actions Réalisées
If Range("C" & Nom + 2).Offset(0, 9).Value = "" Then
Else
DTPicker4 = Range("C" & Nom + 2).Offset(0, 9).Value
End If
If Range("C" & Nom + 2).Offset(0, 10).Value = "" Then
Else
TextBox57 = Range("C" & Nom + 2).Offset(0, 10).Value
End If
If Cells(Nom + 3, 3) = "" Then
'4ème Restriction
ComboBox14 = Range("C" & Nom + 3).Offset(0, 6).Value
ComboBox15 = Range("C" & Nom + 3).Offset(0, 7).Value
TextBox40 = Range("C" & Nom + 3).Offset(0, 8).Value
If Cells(Nom + 4, 3) = "" Then
'5ème Restriction
ComboBox16 = Range("C" & Nom + 4).Offset(0, 6).Value
ComboBox17 = Range("C" & Nom + 4).Offset(0, 7).Value
TextBox41 = Range("C" & Nom + 4).Offset(0, 8).Value
If Cells(Nom + 5, 3) = "" Then
'6ème Restriction
ComboBox18 = Range("C" & Nom + 5).Offset(0, 6).Value
ComboBox19 = Range("C" & Nom + 5).Offset(0, 7).Value
TextBox42 = Range("C" & Nom + 5).Offset(0, 8).Value
If Cells(Nom + 6, 3) = "" Then
'7ème Restriction
ComboBox20 = Range("C" & Nom + 6).Offset(0, 6).Value
ComboBox21 = Range("C" & Nom + 6).Offset(0, 7).Value
TextBox43 = Range("C" & Nom + 6).Offset(0, 8).Value
End If
End If
End If
End If
End If
End If
'Imprime
'Application.ScreenUpdating = False
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
With ActiveSheet
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
.Range("A1").Activate
.PageSetup.Orientation = xlLandscape
.PageSetup.LeftMargin = Application.InchesToPoints(0)
.PageSetup.RightMargin = Application.InchesToPoints(0)
.PageSetup.TopMargin = Application.InchesToPoints(0.3)
.PageSetup.BottomMargin = Application.InchesToPoints(0)
.PageSetup.HeaderMargin = Application.InchesToPoints(0)
.PageSetup.FooterMargin = Application.InchesToPoints(0)
.PageSetup.PrintHeadings = False
.PageSetup.PrintGridlines = False
.PageSetup.PrintComments = xlPrintNoComments
.PageSetup.CenterHorizontally = True
.PageSetup.CenterVertically = True
.PageSetup.Draft = False
.PageSetup.PaperSize = xlPaperA4
.PageSetup.Order = xlDownThenOver
.PageSetup.BlackAndWhite = False
.PageSetup.Zoom = 80
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
'Application.ScreenUpdating = True
Msg = Msg & "La fiche de " & Statut.Offset(0, 1) & " " & Statut.Offset(0, 2) & " a été imprimée." & Chr(10)
End If
Next Statut
MsgBox Msg
End With
Unload UserForm5
End SubMerci beaucoup frangy.
J'ai plus qu'un petit problème d'impression mais ce n'est plus le même sujet.
A beintôt ! et encore merci