Microsoft 365 Incrémenter nouvelle fiche et sous fiche

[pompaero]

Bonjour le forum,

J'essais de construire et automatiser un maximum de point sur une fiche pour mon travail. Le fichier joint est à titre d'exemple que je dois refaire son mon fichier original.
Cette fiche est très importante pour mon service (il s'agit de faire un bilan sur intervention).
La fiche est déjà finalisé pour sa présentation et j'ai commencé quelques macros afin de garder les infos dans une BDD.
Ma 1ère demande d'aide se porte sur le n° de la fiche.
Le principe est de créer un nouveau n° de fiche lors d'une nouvelle intervention. J'aimerai que ce n° 'incrémente automatiquement, c'est à dire,
Avoir comme réf : l'année, n° incrémenté suivi d'un zéro.
ensuite sur une même intervention (une victime) il est possible d'effectuer plusieurs fiches d'ou le zéro en fin de n°, c'est la aussi ou il faudrait incrémenter si nécessaire.
Par exemple:
1ère intervention,
* Victime Alpha, = fiche n° 2020.01 - 0
si besoin de refaire un second bilan alors la fiche reviens vierge et passe au n° 2020.01 - 1
etc...
2ème intervention,
* Victime Bravo, = fiche n° 2020.02 - 0
pas besoin de bilan complémentaire, le n° reste comme cela.
3ème intervention,
* Victime Charlie, = fiche n° 2020.03 - 0
si besoin de refaire un second bilan alors la fiche reviens vierge et passe au n° 2020.03 - 1
si besoin de refaire un troisième bilan alors la fiche reviens vierge et passe au n° 2020.03 - 2
etc...
J'espère être assez explicite, si non n’hésiter pas à revenir vers moi.
Voila ma vision des choses, si d'autres propositions seraient mieux adaptés, je suis preneur également.
Merci d'avance de votre aide

Cdl

 

[Compte Supprimé 979]

Salut pompaero

Alors ta procédure Enregistrement de ton PDF devrait être comme ça

Sub EnrPDF_FicheSap()
  Dim sChemin As String, sDateHeure As String, sNumFiche As String, sNomFic As String
  ' En Cas d'erreur
  On Error GoTo Err_Proc
  ' Désactiver l'écran
  Application.ScreenUpdating = False
  ' Chemin d'enregistrement du fichier
  sChemin = "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Archive documents en pdf\Secours à personne\"
  ' Avec la feuille
  With Sheets("FicheSap")
    ' Récupérer les informations nécessaires
    sDateHeure = Format(.Range("D3"), "yyyymmdd") & "-" & Format(Time, "hhmm")
    sNumFiche = .Range("D2").Value
    ' Activer la feuille (pas forcément nécessaire)
    .Activate
    ' Déprotéger
    .Unprotect ("123")
    ' Déterminer le nom du fichier en concaténant les infos
    sNomFic = "SAP du " & sDateHeure & " " & sNumFiche & ".pdf"
    ' Exporter la feuille en fichier PDF
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=sChemin & sNomFic, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Protect ("123")
  End With
  Application.ScreenUpdating = True
  Exit Sub

Err_Proc:
  MsgBox "Désolé, une erreur c'est produite à l'export PDF du fichier" & vbCr & vbCr _
  & Err.Number & " - " & Err.Description, vbCritical, "OUPS..."
  ' Dans cette situation on arrête la
End Sub

Si tu as une erreur, cela peut être le chemin d'enregistrement qui n'est pas bon, tout simplement.
Tu peux éventuellement utiliser une fonction qui teste son existence

Public Function DossierExiste(MonDossier As String)
  If Len(Dir(MonDossier, vbDirectory)) > 0 Then
     DossierExiste = True
  Else
     DossierExiste = False
  End If
End Function

@+

 

[pompaero]

Salut BrunoM45,

Ta procédure fonctionne bien et effectivement cela à l'air d'aller mieux.
Je pense avoir terminé ce projet, je l'ai installé dans mon service pour tester. Mes agents sont satisfait de la présentation et du fonctionnement.
Sans ton aide je n'aurai pas atteint un travail aussi parfait.
Je t'en remercie sincèrement.
Je maintien encore actif ce fil en cas de besoin, on ne sais jamais.

Grand merci pour tout et certainement à bientôt pour d'autres aventures.

pompaero

 

[corsu2a]

Salut BrunoM45,

Ta procédure fonctionne bien et effectivement cela à l'air d'aller mieux.
Je pense avoir terminé ce projet, je l'ai installé dans mon service pour tester. Mes agents sont satisfait de la présentation et du fonctionnement.
Sans ton aide je n'aurai pas atteint un travail aussi parfait.
Je t'en remercie sincèrement.
Je maintien encore actif ce fil en cas de besoin, on ne sais jamais.

Grand merci pour tout et certainement à bientôt pour d'autres aventures.

pompaero

Bonjour @pompaero
Votre fichiers est super, auriez vous le fichier final.
Merci