Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Compteur excel - compteur à chaque impression

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Monhtc
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

Monhtc

XLDnaute Occasionnel
J’ai un fichier excel dans lequel je numérote le document. J’aimerais que la numérotation se fasse automatiquement dans la celulle B9 à chaque impression sous le format N 001/"mois"/"année"/MICROSOFT/EXCEL
Si quelqu’un a une solution pour moi je suis preneur d’autant plus que je ne suis pas expert dans l’utilisation d’excel…

Merci d’avance
 
Trier par date Trier par votes
Bonjour Monhtc,

Placez cette macro dans ThisWorkbook et menu FICHIER => Imprimer :
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim c As Range, test As Boolean
Cancel = True 'pour tester sans imprimer, à supprimer pour imprimer
Set c = Sheets("Feuil1").[B9] 'nom de la feuille à adapter
test = c Like "N ###/##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 7, 2) And Year(Date) = Val(Mid(c, 10, 4))
c = IIf(test, "N " & Format(Val(Mid(c, 3, 3)) + 1, "000") & Mid(c, 6, 99), "N 001/" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
End Sub
Le numéro est incrémenté à chaque impression et revient à 001 chaque fois que la date du jour change de mois ou d'année.

Comme indiqué supprimez Cancel = True pour imprimer.

A+
 
Vote positif 0 Vote négatif
Merci Job75 pour votre assistance
j'ai joint au fichier. Par ailleurs je souhaite que ce numéro soit remis à 0 chaque début d'un nouveau mois et d'une nouvelle année plutôt que chaque jour... MERCI INFINIMENT
 

Pièces jointes

Vote positif 0 Vote négatif
Monhtc à dit:
Par ailleurs je souhaite que ce numéro soit remis à 0 chaque début d'un nouveau mois et d'une nouvelle année plutôt que chaque jour...
Cliquez pour agrandir...
Si vous comprenez le français :
job75 à dit:
Le numéro est incrémenté à chaque impression et revient à 001 chaque fois que la date du jour change de mois ou d'année.
Cliquez pour agrandir...
Sinon vous n'avez qu'à tester mon code qui doit être placé, je le répète, dans ThisWorkbook.
 
Vote positif 0 Vote négatif
Ca marche nickel et impec. GRAND MERCI.
bonjour chers tous,
Mais comment puis-je enregistrer (beforeprint) en format pdf dans le fichier source avec pour nom les cellules B9 et D12
Exemple: "B9"-"D12".pdf
 
Vote positif 0 Vote négatif
Bonjour Monhtc, le forum,
Monhtc à dit:
Mais comment puis-je enregistrer (beforeprint) en format pdf
Cliquez pour agrandir...
Toujours dans ThisWorkbook :
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n As Byte, c As Range, test As Boolean, fichier
With Sheets("Feuil1") 'nom de la feuille à adapter
    .Activate
    n = MsgBox("Imprimer en PDF ?", 3, "Imprimer")
    If n = vbCancel Then Cancel = True: Exit Sub
    Set c = .[B9]
    test = c Like "N ###/##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 7, 2) And Year(Date) = Val(Mid(c, 10, 4))
    c = IIf(test, "N " & Format(Val(Mid(c, 3, 3)) + 1, "000") & Mid(c, 6, 99), "N 001/" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
    If n = vbYes Then
        Cancel = True 'annule l'impression normale
        fichier = ThisWorkbook.Path & "\" & c & " - " & .[D12] 'à adapter
        Application.EnableEvents = False 'désactive les évènements
        .ExportAsFixedFormat xlTypePDF, Replace(fichier, "/", " ") 'le slash / est un caratère interdit
        Application.EnableEvents = True 'réactive les évènements
    End If
End With
End Sub
Il faut éviter les caractères interdits dans les noms des fichiers \ / : * ? " < > |

A+
 
Vote positif 0 Vote négatif
Avec la macro précédente seule la feuille indiquée peut être imprimée.

Si l'on veut pouvoir imprimer les autres feuilles du classeur (sans incrémenter de numéro) :
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n As Byte, c As Range, test As Boolean, fichier
With Sheets("Feuil1") 'nom de la feuille à adapter
    If ActiveSheet.Name <> .Name Then Exit Sub 'permet d'imprimer d'autres feuilles
    n = MsgBox("Imprimer en PDF ?", 3, "Imprimer")
    If n = vbCancel Then Cancel = True: Exit Sub
    Set c = .[B9]
    test = c Like "N ###/##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 7, 2) And Year(Date) = Val(Mid(c, 10, 4))
    c = IIf(test, "N " & Format(Val(Mid(c, 3, 3)) + 1, "000") & Mid(c, 6, 99), "N 001/" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
    If n = vbYes Then
        Cancel = True 'annule l'impression normale
        fichier = ThisWorkbook.Path & "\" & c & " - " & .[D12] 'à adapter
        Application.EnableEvents = False 'désactive les évènements
        .ExportAsFixedFormat xlTypePDF, Replace(fichier, "/", " ") 'le slash / est un caratère interdit
        Application.EnableEvents = True 'réactive les évènements
    End If
End With
End Sub
 
Vote positif 0 Vote négatif
Merci Jobs tous marche à merveille. sauf que lorsque j'ai modifier le préfixe en rajoutant le symbole numéro (°), la série ne s’incrémente plus.
voici mon code modifier.
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n As Byte, c As Range, test As Boolean, fichier
With Sheets("MENU")
.Activate
n = MsgBox("Imprimer en PDF ?", 3, "Imprimer")
If n = vbCancel Then Cancel = True: Exit Sub
Set c = .[B9]
test = c Like "N°CC ###-##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 7, 2) And Year(Date) = Val(Mid(c, 10, 4))
c = IIf(test, "N°CC" & Format(Val(Mid(c, 3, 3)) + 1, "000") & Mid(c, 6, 99), "N°CC 001-" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
If n = vbYes Then
Cancel = True
fichier = ThisWorkbook.Path & "\" & c & " - " & .[D12] 'à adapter
Application.EnableEvents = False 'désactive les évènements
.ExportAsFixedFormat xlTypePDF, Replace(fichier, "/", " ")
Application.EnableEvents = True 'réactive les évènements
End If
End With
 
Vote positif 0 Vote négatif
Bonjour Monhtc,

Puisqu'on ajoute 3 caractères il faut décaler de 3 dans les fonctions Mid :
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n As Byte, c As Range, test As Boolean, fichier
With Sheets("MENU") 'nom de la feuille à adapter
    If ActiveSheet.Name <> .Name Then Exit Sub 'permet d'imprimer d'autres feuilles
    n = MsgBox("Imprimer en PDF ?", 3, "Imprimer")
    If n = vbCancel Then Cancel = True: Exit Sub
    Set c = .[B9]
    test = c Like "N°CC ###/##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 10, 2) And Year(Date) = Val(Mid(c, 13, 4))
    c = IIf(test, "N°CC " & Format(Val(Mid(c, 6, 3)) + 1, "000") & Mid(c, 9, 99), "N°CC 001/" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
    If n = vbYes Then
        Cancel = True 'annule l'impression normale
        fichier = ThisWorkbook.Path & "\" & c & " - " & .[D12] 'à adapter
        Application.EnableEvents = False 'désactive les évènements
        .ExportAsFixedFormat xlTypePDF, Replace(fichier, "/", " ") 'le slash / est un caratère interdit
        Application.EnableEvents = True 'réactive les évènements
    End If
End With
End Sub
A+
 
Vote positif 0 Vote négatif
J'au rajouter à la suite du code "befrore print" celui ci pour sauvegarder sur une seconde feuille mes elements question de consitituer une base de données mais elle ne s'alimente pas:
VB: 
C = Worksheets("Feuil2").Range("A2").Value
Worksheets("Feuil1").Range("D12").Value = Worksheets("Feuil2").Range("B2").Value
Worksheets("Feuil1").Range("D13").Value = Worksheets("Feuil2").Range("C2").Value
Worksheets("Feuil1").Range("D14").Value = Worksheets("Feuil2").Range("D2").Value
Worksheets("Feuil1").Range("D15").Value = Worksheets("Feuil2").Range("E2").Value
Worksheets("Feuil1").Range("D16").Value = Worksheets("Feuil2").Range("F2").Value
Worksheets("Feuil1").Range("D17").Value = Worksheets("Feuil2").Range("G2").Value
Worksheets("Feuil1").Range("G4").Value = Worksheets("Feuil2").Range("H2").Value
Worksheets("Feuil1").Range("G6").Value = Worksheets("Feuil2").Range("I2").Value
 
Vote positif 0 Vote négatif
Bonjour Job75 j'ai essayé de compléter mon code dans l'objetif de pouvoir copier la valeur de cellule de la feuille 1 dans un tableau dans la feuille 2 en vue de renseigner une base de données
VB: 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim n As Byte, c As Range, test As Boolean, fichier
With Sheets("MENU") 'nom de la feuille à adapter
    If ActiveSheet.Name <> .Name Then Exit Sub 'permet d'imprimer d'autres feuilles
    n = MsgBox("Imprimer en PDF ?", 3, "Imprimer")
    If n = vbCancel Then Cancel = True: Exit Sub
    Set c = .[B9]
    test = c Like "N°CC ###/##/####/MICROSOFT/EXCEL" And Format(Month(Date), "00") = Mid(c, 10, 2) And Year(Date) = Val(Mid(c, 13, 4))
    c = IIf(test, "N°CC " & Format(Val(Mid(c, 6, 3)) + 1, "000") & Mid(c, 9, 99), "N°CC 001/" & Format(Date, "mm/yyyy") & "/MICROSOFT/EXCEL")
    If n = vbYes Then
        Cancel = True 'annule l'impression normale
        fichier = ThisWorkbook.Path & "\" & c & " - " & .[D12] 'à adapter
        Application.EnableEvents = False 'désactive les évènements
        .ExportAsFixedFormat xlTypePDF, Replace(fichier, "/", " ") 'le slash / est un caratère interdit
        Application.EnableEvents = True 'réactive les évènements
    End If
End With
C = Worksheets("Feuil2").Range("A2").Value
Worksheets("Feuil1").Range("D12").Value = Worksheets("Feuil2").Range("B2").Value
Worksheets("Feuil1").Range("D13").Value = Worksheets("Feuil2").Range("C2").Value
Worksheets("Feuil1").Range("D14").Value = Worksheets("Feuil2").Range("D2").Value
Worksheets("Feuil1").Range("D15").Value = Worksheets("Feuil2").Range("E2").Value
Worksheets("Feuil1").Range("D16").Value = Worksheets("Feuil2").Range("F2").Value
Worksheets("Feuil1").Range("D17").Value = Worksheets("Feuil2").Range("G2").Value
Worksheets("Feuil1").Range("G4").Value = Worksheets("Feuil2").Range("H2").Value
Worksheets("Feuil1").Range("G6").Value = Worksheets("Feuil2").Range("I2").Value
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Question Question
XL pour MAC Classeur Excel pour tenue de livre
Réponses
1
Affichages
160
wDog66
U
  • Résolu(e)
Microsoft 365 planning étude
Réponses
5
Affichages
235
bsalv
B
F
  • Question Question
XL 2016 Tableau de bord Excel 2016
Réponses
2
Affichages
481
Dand87
D
B
  • Question Question
Word Recherche et tri sur WORD
Réponses
1
Affichages
260
mromain
M
  • Résolu(e)
XL 2021 calcul : Somme des quantités de chaque produit à fabriquer
Réponses
3
Affichages
875
MinstrelL
M
S
  • Question Question
XL 2021 Mon aperçu ne correspond pas à mon document
Réponses
3
Affichages
1 K
Gégé-45550
M
  • Question Question
XL 2021 Aide pour sauvegarde des données dans un calendrier automatique Excel
Réponses
2
Affichages
160
mimednejma
M
F
  • Question Question
XL 2016 Onglets très masqués VBA à chaque réouverture de fichier
Réponses
4
Affichages
445
Fanny754
F
M
  • Question Question
Microsoft 365 Ajout de cas à cocher et mise en forme conditionnelle dans un tableau Excel
Réponses
9
Affichages
444
mimednejma
M
J
  • Question Question
XL 2019 Nommer exportation
Réponses
7
Affichages
1 K
JacquesO
J
B
  • Question Question
XL 2013 Transposition de filtres multiples sur plusieurs feuilles
Réponses
11
Affichages
824
BIROULIG
B
A
  • Question Question
Microsoft 365 Fichier de statistique et roulement
Réponses
0
Affichages
540
Aurel’Byylieve
A
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
797
JacquesO
J
A
  • Question Question
XL 2021 Automatiser la génération de documents Word à partir d’Excel avec VBA
Réponses
12
Affichages
887
ali591
A
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
489
picc
P
S
  • Question Question
XL 2016 Comment attribuer des classes avec trois conditions?
Réponses
7
Affichages
248
TooFatBoy
R
  • Question Question
XL 2019 Aide à la création d'un fichier de saisie et suivi des engagements budgétaires sous Excel
Réponses
2
Affichages
278
Royaulté
R
B
  • Question Question
XL 2016 VBA formulaire incrémenter un N° de facture selon l'année(mais dates sur deux colonnes)
Réponses
4
Affichages
705
badduke
B
C
  • Question Question
XL 2013 comment copier une mise en forme automatiquement avec une formule ?
Réponses
6
Affichages
949
fanch55
J
  • Question Question
Word Utiliser champs de publipostage pour nommer fichier .PDF
Réponses
2
Affichages
734
kiki29
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…