Excel 2016 : Numéro FD à incrémenter

[kdet]

Bonjour le Forum, à tous et à toutes,

De retour parmi vous pour trouver de l'aide.

 

[kdet]

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

Merci de votre aide.

kdet

 

[Dranreb]

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.

 

[kdet]

Bonjour Danreb, le forum,

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

 

[Dranreb]

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 ?

 

[kdet]

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

 

[Dranreb]

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.

 

[kdet]

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

kdet

 

[Dranreb]

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

 

[Dranreb]

Essayez comme ça :

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

 

[kdet]

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

 

[job75]

Bonjour kdet, Bernard,

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

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+

 

[kdet]

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

 

[job75]

Question 1 : oui, il suffit de tester.

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

 

[kdet]

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