C
CYRILMAXX
Guest
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ù 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 Fermeture🙁X).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
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ù 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 Fermeture🙁X).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
