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

VB:
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

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

XLDnaute Impliqué
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
VB:
=RECHERCHEV(CAR(255);B:B;1)

Cdlt
 

pompaero

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

Pièces jointes

  • Fiche bilan en construction.xlsm
    163.1 KB · Affichages: 8
C

Compte Supprimé 979

Guest
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 !?

@+
 

Pièces jointes

  • 2020-08-29_17h37_41.png
    2020-08-29_17h37_41.png
    10.5 KB · Affichages: 15
C

Compte Supprimé 979

Guest
Re,

Ce n'est pas ce que tu dis dans ton post #4 :p ;)
Voici la formule :
VB:
=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

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

Pièces jointes

  • Fiche bilan en construction.xlsm
    165.4 KB · Affichages: 2
C

Compte Supprimé 979

Guest
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
VB:
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

@+
 

Pièces jointes

  • Pompareo_Fiche bilan en construction v0902.xlsm
    175.1 KB · Affichages: 12

pompaero

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

Compte Supprimé 979

Guest
Salut Pompaero ;)

1) Je ne comprends pas ta procédure
VB:
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
Code:
FileN = Format(Range("D3"), "yyyymmdd") & "-" & Format(Time, "hhmm") & ".pdf"
Tu définis le chemin complet avec ce nom
Code:
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
Code:
Filename:=Chemin1 & " n°" & .Range("D2").Value

Ca doit faire un beau merdier à la fin :p

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 :
Code:
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

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

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 902
Membres
101 834
dernier inscrit
Jeremy06510