RàZ incrémentation

Thibault2612 · 28 Mai 2017

Bonjour à tous,

Je souhaite faire un remise à zéro d'une incrémentation à chaque changement d'année.

En effet, mon incrémentation incrémente de +1 à chaque demande d'impression. Mais je veux qu'elle se remette à zéro dès que l'on change d'année.

Je vous remercie d'avance pour l'aide apportée.

Cordialement.
(Je ne peux mettre en pièce jointe mon fichier...)

CISCO · 28 Mai 2017

Bonjour

Thibault2612 à dit:
Bonjour à tous,
Je souhaite faire un ...
Cordialement.
(Je ne peux mettre en pièce jointe mon fichier...)

Pourquoi ?

@ plus

job75 · 28 Mai 2017

Bonjour Thibault2612, CISCO,

Code VBA à placer dans ThisWorkbook (Alt+F11) :

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True 'pour tester, mettre en commentaire pour pouvoir imprimer
If Not IsDate([Madate]) Then Me.Names.Add "MaDate", "1/1/100"
If Year(Date) > Year([Madate]) Or Not IsNumeric([MonCompte]) Then Me.Names.Add "MonCompte", 0
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
Me.Names.Add "MonCompte", [MonCompte] + 1 ', Visible:=False 'si l'on veut masquer le nom défini
MsgBox [MonCompte] 'pour tester
End Sub

Le nom défini MaDate contient la date de la dernière impression.

Le nom défini MonCompte contient le nombre d'impressions depuis le début de l'année.

Ces noms définis peuvent être masqués.

A+

job75 · 28 Mai 2017

Re,

Bien sûr chacun sait récupérer dans une feuille les valeurs des 2 noms définis :

- en A1 =MaDate ou si l'on veut une vraie date =DATEVAL(MaDate), cellule à formater

- en A2 =MonCompte

A+

Thibault2612 · 29 Mai 2017

Bonjour,

Je vous remercie de votre aide néanmoins j'ai utilisé une syntaxe différente de la votre pour l'incrémentation.

Je vous met mon code ThisWorkbook ci-dessous.

VB:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Sheets("Paramétrage").[K6] = Sheets("Paramétrage").[K6] + 1
End Sub

J'aimerais savoir comment faire la remise à zéro de cette incrémentation de façon a ce qu'elle se remette à zéro au changement de l'année sans rien faire.

Cordialement

job75 · 29 Mai 2017

Bonjour Thibault2612, le forum,

Alors un seul nom défini suffit :

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = True 'pour tester, mettre en commentaire pour pouvoir imprimer
If Not IsDate([MaDate]) Then Me.Names.Add "MaDate", "1/1/100"
With Sheets("Paramétrage").[K6] 'à adapter
  If Year(Date) > Year([MaDate]) Or Not IsNumeric(.Value) Then .Value = 0
  .Value = .Value + 1
End With
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
End Sub

La remise à zéro a lieu à la 1ère impression de l'année.

Bonne journée.

Thibault2612 · 29 Mai 2017

Bonjour,
Je vous remercie, la remise à zéro est niquel. En revanche, pour l'incrémentation il y a un petit soucis.
Si j'imprime avec 3 copies, l'incrémentation réalise +1 alors que je voudrais +3.
Merci de votre aide

job75 · 29 Mai 2017

Re,

Il faut contrôler l'impression :

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n%
Cancel = True
n = Int(Val(InputBox("Nombre de copies :", "Imprimer")))
If n < 1 Then Exit Sub
ActiveSheet.PrintOut Copies:=n 'impression
If Not IsDate([MaDate]) Then Me.Names.Add "MaDate", "1/1/100"
With Sheets("Paramétrage").[K6] 'à adapter
  If Year(Date) > Year([MaDate]) Or Not IsNumeric(.Value) Then .Value = 0
  .Value = .Value + n
End With
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
End Sub

A+

job75 · 29 Mai 2017

Re,

Si l'on veut éviter un bug quand l'utilisateur entre 111111111111111111 dans l'InputBox :

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error Resume Next
Dim n%
Cancel = True
n = Int(Val(InputBox("Nombre de copies :", "Imprimer")))
If n < 1 Then Exit Sub
ActiveSheet.PrintOut Copies:=n 'impression
If Not IsDate([MaDate]) Then Me.Names.Add "MaDate", "1/1/100"
With Sheets("Paramétrage").[K6] 'à adapter
  If Year(Date) > Year([MaDate]) Or Not IsNumeric(.Value) Then .Value = 0
  .Value = .Value + n
End With
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
End Sub

A+

Thibault2612 · 29 Mai 2017

Re bonjour,
J'utilise déjà une variable pour le nombre de copies à imprimer
Pouvez vous me dire comment je l'intègre à votre code ?

Code:

Sub test()
Dim nbCopies As Long

    nbCopies = ActiveSheet.Range("D2").Value

    With ActiveSheet
        .PageSetup.PrintArea = "$B$7:$B$8"
        .PrintOut copies:=nbCopies
    End With
End Sub

job75 · 29 Mai 2017

Re,

Vous devez être pharmacien pour distiller les informations au compte-gouttes :

Code:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error Resume Next
Dim nbCopies As Integer
Cancel = True
With ActiveSheet
  nbCopies = Int(Val(.[D2]))
  If nbCopies < 1 Then Exit Sub
  .PageSetup.PrintArea = "$B$7:$B$8"
  .PrintOut Copies:=nbCopies 'impression
End With
If Not IsDate([MaDate]) Then Me.Names.Add "MaDate", "1/1/100"
With Sheets("Paramétrage").[K6] 'à adapter
  If Year(Date) > Year([MaDate]) Or Not IsNumeric(.Value) Then .Value = 0
  .Value = .Value + nbCopies
End With
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
End Sub

nbCopies doit être déclaré Integer car on ne peut pas faire plus de 32767 copies (sur Excel 2013).

A+

Thibault2612 · 29 Mai 2017

Re bonjour,
Pour être honnête je suis un peu perdu... je doit garder le module (Sub Test) ET ajouter votre code dans ThisWorkbook ?

J'aimerais garder ma macro d'impression ET ajouter l'incrémentation et la remise à zéro dans ThisWorkbook si possible.

Merci beaucoup

Je vous met ma première macro ici

Code:

Sub Imprim()
    If MsgBox("Opération irréversible. Souhaitez-vous continuez ?", vbYesNo + vbQuestion + vbDefaultButton1, "Confirmation d'action") = vbNo Then
    Exit Sub
    End If

    Dim nbCopies As Long

    nbCopies = Sheets(2).Range("D2").Value

     With ActiveSheet
        .PageSetup.PrintArea = "$B$7:$B$8"
        .PrintOut Copies:=nbCopies
     End With

   
End Sub

job75 · 29 Mai 2017

Re,

Puisque vous n'êtes pas fichu de nous montrer votre fichier j'en ai fait un avec ce code :

Code:

Dim nbCopies As Integer 'mémorise la variable

Sub Imprimer()
On Error Resume Next
With ActiveSheet
  nbCopies = Int(Val(.[D2]))
  If nbCopies < 1 Then Exit Sub
  If MsgBox("Opération irréversible. Souhaitez-vous continuer ?", 4, "Imprimer") = 7 Then nbCopies = 0: Exit Sub
  .PageSetup.PrintArea = "$B$7:$B$8"
  .PrintOut Copies:=nbCopies
End With
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If nbCopies < 1 Then Cancel = True: Exit Sub
If Not IsDate([MaDate]) Then Me.Names.Add "MaDate", "1/1/100"
With Sheets("Paramétrage").[K6] 'à adapter
  If Year(Date) > Year([MaDate]) Or Not IsNumeric(.Value) Then .Value = 0
  .Value = .Value + nbCopies
End With
Me.Names.Add "MaDate", Format(Date, "d/m/yyyy") ', Visible:=False 'si l'on veut masquer le nom défini
nbCopies = 0 'RAZ
End Sub

On ne peut imprimer qu'en cliquant sur le bouton "Imprimer".

A+

Thibault2612 · 29 Mai 2017

Je vous remercie.

job75 · 29 Mai 2017

Re,

J'ai corrigé mon post #13 précédent en remplaçant :

Code:

If MsgBox("Opération irréversible. Souhaitez-vous continuer ?", 4, "Imprimer") = 7 Then Exit Sub

par :

Code:

If MsgBox("Opération irréversible. Souhaitez-vous continuer ?", 4, "Imprimer") = 7 Then nbCopies = 0: Exit Sub

A+

RàZ incrémentation

Thibault2612

XLDnaute Junior

CISCO

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Thibault2612

XLDnaute Junior

job75

XLDnaute Barbatruc

Thibault2612

XLDnaute Junior

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Thibault2612

XLDnaute Junior

job75

XLDnaute Barbatruc

Thibault2612

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

Thibault2612

XLDnaute Junior

job75

XLDnaute Barbatruc

Discussions similaires