Excel 2016 : Numéro FD à incrémenter

kdet

XLDnaute Occasionnel

• 25 Mars 2019

• #2

J'ai oublié de joindre le fichier. j'ai tout expliquer dans le fichier.

Merci de votre aide.

kdet

 

Pièces jointes

• Numéro FD à incrémenter.xlsm

  18.6 KB · Affichages: 13

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 25 Mars 2019

• #3

Sélectionnez SheetActivate dans la liste de droite qui surmonte la fenêtre de code, dans ThisWorkbook,
et mettez votre code dans cette Private Sub Workbook_SheetActivate.

 

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 25 Mars 2019

• #4

Bonjour Danreb, le forum,

j'ai suivi votre conseil, et voici la réponse quand je clique sur l'onglet MSC

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 25 Mars 2019

• #5

Est-ce bien ce que vous voulez faire ?
j'aurais mieux compris que votre expression Worksheet soit partout Sh plutôt que Sheets("FNR")
Cela dit je ne sais pas pourquoi ça plante, d'autant plus que vous ne m'indiquez pas le message d'erreur.
Peut être n'y a-t-il du texte dans cette cellule D2 ?

 

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 25 Mars 2019

• #6

Danreb,

c'est bien ce que je voulais en premier lieu et le message d'erreur est : "Erreur d'exécution '13' " Incompatibilité de type.

Cdlmt,

kdet

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 25 Mars 2019

• #7

Oui ça se confirme. On ne peut pas ajouter 1 à une cellule qui contient du texte, du logique ou une erreur.
Il faut qu'elle contienne un nombre, ou à la rigueur qu'elle soit vide.

 

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 25 Mars 2019

• #8

Donc on ne peut pas résoudre mon problème alors??? ou est-ce qu'il y a une autre méthode ou ...

kdet

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 25 Mars 2019

• #9

Non, je n'ai pas dit ça. C'est seulement plus compliqué que de simplement ajouter 1 à la cellule.

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 25 Mars 2019

• #10

Essayez comme ça :

VB:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   Dim Wsh As Worksheet, Série As String, AnMois As String, TSpl() As String
   If Not TypeOf Sh Is Worksheet Then Exit Sub
   Set Wsh = Sh
   Série = Wsh.[D2].Value
   If MsgBox("Voulez-vous incrémentrer ce numéro """ & Série & """ ?", _
      vbQuestion + vbYesNo, "Feuille " & Wsh.Name) = vbNo Then Exit Sub
   AnMois = Format(Date, "yyyymm")
   TSpl = Split(Série, "/")
   If TSpl(0) < AnMois Then
      TSpl(0) = AnMois
      TSpl(1) = Wsh.Name & "001"
   Else
      TSpl(1) = Wsh.Name & Format(Right(TSpl(1), 3) + 1, "000")
      End If
   Wsh.[D2].Value = Join(TSpl, "/")
   End Sub

 

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 25 Mars 2019

• #11

Danreb,

Tu m'as sauvé pour une partie de mon problème. Vu qu'on est encore en 2019, est-ce l'année s'incrément +1 pour avoir 2020 pour l'année suivante?
Denière question, une fois le FD terminé et imprimé suivant la sélection est-ce qu'on peut ajouter un code pour l'enregistrement sous format .pdf pour archives?

Merci d'avance,

kdet

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 25 Mars 2019

• #12

Bonjour kdet, Bernard,

Avec ce code dans ThisWorkbook l'incrémentation a lieu chaque fois qu'on imprime une feuille :

VB:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim c As Range, chemin$
Cancel = True 'pour tester sans imprimer, à supprimer pour imprimer
Set c = [D2]
If c Like "######/" & ActiveSheet.Name & "###" And Val(Left(c, 4)) = Year(Date) And Mid(c, 5, 2) = Format(Month(Date), "00") Then
    c = Left(c, Len(c) - 3) & Format(Val(Right(c, 3)) + 1, "000")
Else
    c = Year(Date) & Format(Month(Date), "00/") & ActiveSheet.Name & "001"
End If
chemin = ThisWorkbook.Path & "\" 'à adapter
Application.EnableEvents = False 'désactive les évènements
ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & Replace(c, "/", " ") 'le slash / est un caratère interdit
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

Pièces jointes

• Numéro FD à incrémenter(1).xlsm

  25.4 KB · Affichages: 7

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 26 Mars 2019

• #13

Bonjour le Forum, Job75, Bernard,

Merci pour ton aide précieux. Deux questions : 1- est-ce que l'enregistrement au format .pdf est automatique si une fois la selection est imprimé? 2- le code "chemin = ThisWorkbook.Path & "\" " (à adapter) est-ce que je dois renseigner dans "\" le chemin où je dois archiver le .pdf?

Cordialement,

kdet

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 26 Mars 2019

• #14

Question 1 : oui, il suffit de tester.

Question 2 : il faut revoir tout le chemin d'accès s'il est différent.

 

Vote positif 0 Vote négatif

kdet

XLDnaute Occasionnel

• 26 Mars 2019

• #15

Bonjour le forum, Job75,

J'ai utilisé et suivi les instructions de ton code. sauf ou incompréhension de ma part, j'ai juste modifié le code (chemin) comme suit :

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim c As Range, chemin$
Set c = [D2]
If c Like "######/" & ActiveSheet.Name & "###" And Val(Left(c, 4)) = Year(Date) And Mid(c, 5, 2) = Format(Month(Date), "00") Then
c = Left(c, Len(c) - 3) & Format(Val(Right(c, 3)) + 1, "000")
Else
c = Year(Date) & Format(Month(Date), "00/") & ActiveSheet.Name & "001"
End If
chemin = ThisWorkbook.Path & "I:\Google Drive\KANDRA\2019\FD PDF\" 'à adapter
Application.EnableEvents = False 'désactive les évènements
ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & Replace(c, "/", " ") 'le slash / est un caratère interdit
Application.EnableEvents = True 'réactive les évènements
End Sub

Le fichier est imprimé mais pour la sauvegarde au format pdf dans le dossier "I:\Google Drive\KANDRA\2019\FD PDF\" là rien ne se passe. je ne sais pas où est ce que ça bloque.

Cordialement,

kdet

 

Vote positif 0 Vote négatif