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,
Voici un code possible explicité pour ta compréhension

Sub Nouveau_Bilan()
  Dim sNumFiche As String, NumBilan As Integer
  Dim sNewNum As String
  ' Récupérer le texte du numéro de fiche
  sNumFiche = ThisWorkbook.Sheets("Feuil1").Range("D2")
  ' Numéro de fiche existant
  NumBilan = Mid(sNumFiche, InStr(1, sNumFiche, "- ") + 2, 3)
  ' Nouveau numéro
  NumBilan = NumBilan + 1
  ' Définir le nouveau numéro
  sNewNum = Left(sNumFiche, InStr(1, sNumFiche, "- ")) & " " & NumBilan
  ' Inscrire le nouveau numéro
  ThisWorkbook.Sheets("Feuil1").Range("D2").Value = sNewNum
End Sub

Sub Nouvelle_Fiche()
  Dim sNumFiche As String, NumFiche As Integer
  Dim sNewNum As String
  ' Récupérer le texte du numéro de fiche
  sNumFiche = ThisWorkbook.Sheets("Feuil1").Range("D2")
  ' Numéro de fiche existant
  NumFiche = Mid(sNumFiche, 6, 2)
  ' Nouveau numéro
  NumFiche = NumFiche + 1
  ' Définir le nouveau numéro
  sNewNum = Year(Now()) & "." & Format(NumFiche, "00") & " - 0"
  ' Inscrire le nouveau numéro
  ThisWorkbook.Sheets("Feuil1").Range("D2").Value = sNewNum
End Sub

@+

 

[pompaero]

Bonjour BrunoM45

Merci de ton retour,
Je regarde et test ta proposition mais aucun doute je suis certain que cela va fonctionner.
Je vais pouvoir avec cela adapter au mieux pour moi, le fonctionnement de cette fiche.
Je n'est plus qu'à me lancer...
J'imagine que de l'aide me sera nécessaire un peu plus tard dans l'avancé de cette fiche.
Merci encore
bonne journée.

Cdlt

 

[pompaero]

Bonjour

J'avance bien dans mon projet de fiche bilan, la présentation est terminée, reste la programmation à terminer.
J'ai intégré les codes de BrunoM45, super codes et effectué l'enregistrement et la remise à zéro.
Du coup les n° de fiche sont enregistrés dans une BDD,
Dans la feuille 2 cellule A1, j'aimerai récupérer la dernière valeur (dernier n° de fiche) de la feuille 1 en colonne B à l'aide d'une formule.
J'ai trouvé cette formule qui fonctionne trés bien mais sur le même feuille.
Comment puis-je faire pour l'améliorer ? merci

=RECHERCHEV(CAR(255);B:B;1)

Cdlt

 

[Compte Supprimé 979]

Salut PompAero

Est-ce que c'est toujours le même fichier avec les mêmes feuilles ?

Parce que si oui, je ne comprends pas ta demande avec feuille 1 et feuille 2

@+

 

[pompaero]

Bonjour BrunoM45

Oui toujours le même fichier qui me sert d'exemple que je joint au message.
Exact c'est feuil1 et BDD (non feuil2).
J'ai commencé quelques codes en test.
Merci

 

[Compte Supprimé 979]

Re,

On est d'accord ou pas, c'est pour inscrire le dernier numéro de fiche de la feuille BDD dans la feuille 1, cellule D2 !?

@+

 

[pompaero]

C'est bien ça..
Ensuite il me faut créer la procédure du déroulement de fonctionnement de tous ces codes des l'ouverture de la fiche jusqu'à l'enregistrement.
Merci

 

[Compte Supprimé 979]

Re,

Ce n'est pas ce que tu dis dans ton post #4
Voici la formule :

=RECHERCHEV(CAR(255);BDD!B:B;1)

Quand tu fais appel à une autre feuille, c'est :
=NomDeLaFeuille!Cellule
ou
='Nom de la Feuille'!Cellule

@+

 

[pompaero]

Re,

Merci ça fonctionne.
C'était juste pour l'exemple, j'ai pas percuté que j'avais mis le fichier avant en pj.

J'essai de coder maintenant.

Merci
Cdlt

 

[pompaero]

Bonjour,

Avec l'aide de BrunoM45, je suis arrivé à bien avancer dans mon projet.
Présentation terminée et j'ai tenté de programmer par moi même (pas facile..), j'imagine que mes codes ne sont pas au top mais je suis arrivé à atteindre l'objectif du fonctionnement.
J'aimerai si cela est possible, faire vérifier mes codes de manière à avoir un peu plus de rapidité et fluidité dans leur exécution, svp.
(neutralisé mais au cas où le code de protection est "123")
Cette fiche est super importante pour mon service.
Merci à vous, par avance.

Cdlt

 

[Compte Supprimé 979]

Salut pompaero

Pour moi ton fichier est franchement bien, quelques petites annotations tout de même
- au clic sur le bouton nouvelle fiche, je mettrais la date en automatique

Sheets("FicheSap").Range("D3").value = Date

- Dans les cellules V2:V4 je ferais des données de validation
- Un petit réglage sur ton bouton valider qui se masque si tu annules

@+

 

[pompaero]

Salut BrunoM45

Merci du compliment, ça fais plaisir de voir que j'arrive à faire seul.
Tes petits réglages sont bien également, la date en auto super ainsi que sur le bouton valider.
J'aimerai savoir pour terminer, pourquoi des lors que j'active la macro d'enregistrement en pdf, l'opération est assez longue à venir ?
Est ce que ma macro est bien construite ?
Est-il possible d'avoir un moyen afin d'éviter l'affichage les bugs (car une dizaine de collaborateurs vont l'utiliser et j'aimerai éviter qu'ils plantent le fichier)
Merci
Cdlt

 

[Compte Supprimé 979]

Salut Pompaero

1) Je ne comprends pas ta procédure

Sub EnrPDF_FicheSap()
  Dim Chemin1 As String
  Application.ScreenUpdating = False
  With Sheets("FicheSap")
    .Activate
    .Unprotect ("123")
    FileN = Format(Range("D3"), "yyyymmdd") & "-" & Format(Time, "hhmm") & ".pdf"
    Chemin1 = "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Archive documents en pdf\Secours à personne\SAP du " & FileN         'modifier en fonction du  chemin dans votre ordinateur
    ' dans les lignes suivantes vous pouvez remplacer sauvegarde par le nom de votre choix, ou éventuellement faire référence à une cellule
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin1 & " n°" & .Range("D2").Value, _
      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    .Protect ("123")
  End With
  Application.ScreenUpdating = True
End Sub

Tu définis un nom de fichier

FileN = Format(Range("D3"), "yyyymmdd") & "-" & Format(Time, "hhmm") & ".pdf"

Tu définis le chemin complet avec ce nom

Chemin1 = "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Archive documents en pdf\Secours à personne\SAP du " & FileN

Puis tu ajoutes à ce nom complet le n° de la fiche

Filename:=Chemin1 & " n°" & .Range("D2").Value

Ca doit faire un beau merdier à la fin

Je ne sais pas quel nom tu veux donner à ton fichier exactement, mais c'est à changer

Sinon l'opération longue est peut-être due à l'enregistrement sur ton serveur !?
Essaye avec un chemin local : "C:\Temp" par exemple

2) pour ce qui est de l'affichage des bugs
- il faut commencer par essayer de déterminer pourquoi ces bugs existent et les corriger
- ensuite tu peux faire la gestion d'erreur toi même
Exemple :

Sub Test()
  ' En cas d'erreur
  On Error Goto Err_Proc
  ' Ton code normal ICI
  ' et ICI
  Exit sub

' A la fin de ta Sub en cas d'erreur
Err_Proc :
  MsgBox "Oups une erreur c'est produite"
  Resume Next    ' Permet de continuer ou le code c'est arrêté
End Sub

@+

 

[pompaero]

Bonjour BrunoM45

Merci pour ton retour.
Oui à priori il y a un problème, j'ai pris modèle sur un autre fichier mais j'ai dû effectuer une erreur, effectivement.
Le nom à donner est : SAP du 20200901-1634.pdf n°2020.06 - 0 (SAP + date + heure.pdf + n° fiche) et bien cela qui ressort avec ma procédure malgré l'erreur.
Pour le reste j'essai de mettre en place tes propositions et reviens de dire.
Merci

Cdlt