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

Microsoft 365 Incrémenter nouvelle fiche et sous fiche

pompaero

XLDnaute Impliqué
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
 

Pièces jointes

  • Fiche bilan en construction.xlsm
    128.7 KB · Affichages: 28
C

Compte Supprimé 979

Guest
Salut pompaero

Alors ta procédure Enregistrement de ton PDF devrait être comme ça
VB:
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
Code:
Public Function DossierExiste(MonDossier As String)
  If Len(Dir(MonDossier, vbDirectory)) > 0 Then
     DossierExiste = True
  Else
     DossierExiste = False
  End If
End Function

@+
 
Dernière modification par un modérateur:

pompaero

XLDnaute Impliqué
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

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

Discussions similaires

Réponses
5
Affichages
452
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…