IMPRIMER sur 1 feuille A4 et non sur 2 feuille A4

[CYRILMAXX]

voici un fichier excel
Je n'arrive pas a imprimer les montants sur une feuille A4 complete.
VOIR LE FICHIER JOINT

quand je sort le recap de mes plvs elles sortent en plusieurs feuilles mais une plv par feuille

merci d'avance pour l'aide.



PS: b34 se retrouve sur i1 :

adresse email
cyrilparm@hotmail.com
Voici mon adresse email pour un contact pour que je puisse envoyer le fichier pour de l'aide merci

fichier macro

Private Sub Quitter_Click()
ImpressionPLV.Hide
MENU_PRINCIPAL.Show
End Sub


Private Sub Imprimer_Click()
Maxligne = 6
NbreImpression = 0
' défini le nombre maxi de rappel de paiement de la MAS par PLV

If TtesPLV = True Then

' imprime uniquement toutes les PLV des MAS dont les Jackpots ont été payés

rep = MsgBox('Cette fonction automatise l'impression des P.L.V nécessaires. Etes-vous bien certain de vos saisies ? ', 17, 'ATTENTION !')

' bouton OK et Annuler (1) plus bulle critique (16) = 17
If rep = vbOK Then
i = 5
With Sheets('Données')
.Unprotect
.Range('Saisie').Sort Key1:='Num MAS', Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
Key2:='Date', Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Trie des données saisies en fonction du Num Mas, la date se fera toute seule automatiquement
.Protect
End With

' 1° Cellule où est indiquée l'impression
Do
' boucle de recherche des plv à imprimer
Sheets('PLV').Range('C8:f16').ClearContents
Sheets('PLV').Range('C41:f48').ClearContents
'Sheets('PLV').Cells(2, 3).ClearContents
Sheets('PLV').Cells(2, 5).ClearContents
'Sheets('PLV').Cells(22, 3).ClearContents
Sheets('PLV').Cells(35, 5).ClearContents

'efface le contenu des cellules

M = 2
'variable définisant la position de la fiche

Do
' boucle de mise en page des plv

If Sheets('Données').Cells(i, 4) = Date - 1 Then

' => A IMPRIMER
Mas = Sheets('Données').Cells(i, 3)
NbreImpression = NbreImpression + 1
Sheets('PLV').Select
' Cells(m, 3) = Mas
' Pour ne pas imprimer le num de la MAS
Cells(M, 5) = Sheets('Données').Cells(i, 6)
' l'emplacement
k = 1
j = 6 '8-m
e = 1
Do
k = k + 1
e = e + 1
i = i + 1
If k > Maxligne Then
'il n'est pas nécessaire de continuer,
'nous sommes au max de lignes imprimables
Exit Do
End If
Loop While Mas = Sheets('Données').Cells(i, 3)
i = i - 1
' une incrémentation de trop si k<Maxligne
f = 1
Do
Cells(M + j, 3) = Sheets('Données').Cells(i, 4)
' la date

'La flèche
Cells(M, 4).Select
Selection.Copy
Cells(M + j, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Symbole Euro
Cells(M, 7).Select
Selection.Copy
Cells(M + j, 6).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' le montant en €
Cells(M + j, 5) = Sheets('Données').Cells(i, 5)



i = i - 1
j = j + 1
f = f + 1
Loop While f <> e

If M = 35 Then
M = 36
Else
M = 35
End If

i = i + e
Else
i = i + 1
End If

Loop While M < 36 And Sheets('Données').Cells(i, 3) <> ''
Sheets('PLV').PrintOut Copies:=1


Loop While Sheets('Données').Cells(i, 3) <> ''
If NbreImpression = 0 Then
rep = MsgBox('Aucune impression possible.' + Chr(13) + '1) Il n'y a pas eu de paiement hier.' + Chr(13) + '2) Vous ne les avez pas saisies.', 64, 'Peux mieux faire.')
Else
rep = MsgBox('Impression de ' + Str(NbreImpression) + ' PLV en cours', 32, 'Patience...')
End If
Else 'si réponse Annuler
rep = MsgBox('Alors, on se trompe de bouton !', 32, 'Ah! Ah! Ah!...')
End If

Hide

ElseIf PLVMAS = True And Num_Mas <> '' Then
' Choix de l'impression d'une seule PLV
i = 5

With Sheets('Données')
.Unprotect
.Range('Saisie').Sort Key1:='Num MAS', Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
Key2:='Date', Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
' Trie des données saisies en fonction du Num Mas, la date se fera toute seule automatiquement

.Protect
End With

' 1° Cellule o&ugrave; est indiquée l'impression
Sheets('PLV').Range('C8:f16').ClearContents
Sheets('PLV').Range('C41:f48').ClearContents
'Sheets('PLV').Cells(2, 3).ClearContents
Sheets('PLV').Cells(2, 5).ClearContents
'Sheets('PLV').Cells(22, 3).ClearContents
Sheets('PLV').Cells(35, 5).ClearContents

'efface le contenu des cellules

Do
' boucle de recherche des plv à imprimer

If Sheets('Données').Cells(i, 4) = Date - 1 Then

' => A IMPRIMER
If Sheets('Données').Cells(i, 3) = Val(Num_Mas) Then
NbreImpression = NbreImpression + 1
Sheets('PLV').Select
'Cells(2, 3) = Val(Num_Mas)
'N'imprime pas le num de la MAS
Cells(2, 5) = Sheets('Données').Cells(i, 6)
' l'emplacement
k = 1
j = 8
e = 1
Do
k = k + 1
e = e + 1
i = i + 1
If k > Maxligne Then
'il n'est pas nécessaire de continuer,
'nous sommes au max de lignes imprimables
Exit Do
End If
Loop While Val(Num_Mas) = Sheets('Données').Cells(i, 3)
i = i - 1
' une incrémentation de trop si k<Maxligne
f = 1
Do
Cells(j, 3) = Sheets('Données').Cells(i, 4)
' la date

'La flèche
Cells(2, 4).Select
Selection.Copy
Cells(j, 4).Select
ActiveSheet.Paste
Application.CutCopyMode = False

'Le symbole Euro
Cells(2, 7).Select
Selection.Copy
Cells(j, 6).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' le montant
Cells(j, 5) = Sheets('Données').Cells(i, 5)



i = i - 1
j = j + 1
f = f + 1
Loop While f <> e

Sheets('PLV').PrintOut Copies:=1
Exit Do
Else
i = i + 1
End If
Else
i = i + 1
End If
Loop While Sheets('Données').Cells(i, 3) <> ''
If NbreImpression = 0 Then
rep = MsgBox('Aucune impression possible.' + Chr(13) + '1) Il n'y a pas eu de paiement hier sur la MAS sélectionnée.' + Chr(13) + '2) Vous ne l'avez pas saisie.' + Chr(13), 64, 'On a un petit problème là !')
End If

Hide

Else ' aucun choix, ou mauvais choix
rep = MsgBox('J'imprime quoi ? ', 32, 'Suivant...')
End If
ImpressionPLV.Hide
Sheets('MIRE').Select
MENU_PRINCIPAL.Show


End Sub

Private Sub Socle_Change()
' recherche le numéro de l'emplacement et l'information en fonction du socle
With Sheets('Référence')
i = 4
' position du 1° Num mas
Do
If .Cells(i, 3) <> Val(Socle) Then
i = i + 1
PLVMAS = False
Else
PLVMAS = True
Modèle = .Cells(i, 5)
Num_Mas = .Cells(i, 2)
i = 123
'180 = 175(Max MAS) + 4 (1°cellule) +1

End If
Loop While i <> 123
End With

End Sub

'*
'La procédure événementielle (UserForm_QueryClose)suivante
'ne permet pas à l'utilisateur de fermer le UserForm en
'cliquant sur le bouton FermetureX).On envoie un message
'----------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox 'Cette commande ne peut pas être exécutée' _
& vbCrLf & 'pour sortir utiliser le bouton Quitter ', _
vbOKOnly + vbCritical, 'Fin du programme'
Cancel = True
End If
End Sub

 

[Bernard_XLD]

les liens avec les autres messages
<Lien supprimé
<Lien supprimé
<Lien supprimé
<Lien supprimé