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

Saiise de Jour identique

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion Loulou
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
L

Loulou

Guest
Bonjour le forum

J'ai fais un programme qui recense les actions d'intervention des pompiers.
Le pompier saisie l'intervention et lorsqu'il valide cella génère un onglet avec la date d'intervention
Jusqu'à là tout va bien.
Mon problème porte s'il y a deux ou trois interventions le même jour.
Je souhaiterais si c'est possible que la première saisie l'onglet se nomme 27/09/06 et si il y a une autre saisie le même jour l'onglet se nomme 27/09/06_1 sur ainsi de suite 27/09/06_2.

Voici mon code

Sub Evenement2(ByVal nom As String)

' maj le 26/09/2006 CAMPELLO Hervé 233534

Sheets("Vierge").Select
Sheets("Vierge").Copy after:=Sheets("Vierge")
Sheets("Vierge (2)").Select
While ActiveSheet.Shapes.Count - 1 > 0
i = ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Delete
Wend

Sheets("Vierge (2)").Name = ca
Range("a2").Select
Sheets("Vierge").Select
Call Miseazero
MsgBox "La nouvelle feuille de " & Sheets("Vierge").Cells(2, 14) & " est prête"
Sheets("Param").Select
F = Cells(2, 9).Value
LienCellule (F)
Sheets("Accueil").Select

End Sub

Sub Evenement1()
ca = Format(Sheets("Vierge").Cells(118, 2), "dd_mm_yy")
Evenement2 (ca)
End Sub


Merci pour votre aide.

Loulou
 
Trier par date Trier par votes
Re : Saiise de Jour identique

bonjour

une proposition à travers une fonction pour retrouver le dernier numéro d'intervention:

code non testé.

Code: 
Public Function recherchenum(ByVal ca As String) As Integer
Dim ws As Worksheet
Dim tablo
Dim max As Integer

For Each ws In Worksheets
    If InStr(1, ws.Name, ca) = 1 Then
        tablo = Split(ws.Name, "_")
        If max < tablo(UBound(tablo)) Then max = tablo(UBound(tablo))
    End If
Next ws

recherchenum = max
End Function
Code: 
Sub Evenement2(ByVal nom As String)

' maj le 26/09/2006 CAMPELLO Hervé 233534

Sheets("Vierge").Select
Sheets("Vierge").Copy after:=Sheets("Vierge")
Sheets("Vierge (2)").Select
While ActiveSheet.Shapes.Count - 1 > 0
i = ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Delete
Wend

Sheets("Vierge (2)").Name = ca & "_" & recherchenum(ca) + 1
Range("a2").Select
Sheets("Vierge").Select
Call Miseazero
MsgBox "La nouvelle feuille de " & Sheets("Vierge").Cells(2, 14) & " est prête"
Sheets("Param").Select
F = Cells(2, 9).Value
LienCellule (F)
Sheets("Accueil").Select

End Sub
Code: 
Sub Evenement1()
ca = Format(Sheets("Vierge").Cells(118, 2), "dd_mm_yy")
Evenement2 (ca)
End Sub
salut
 
Vote positif 0 Vote négatif
Re : Saiise de Jour identique

Bonjour

essaie ainsi

Sub Evenement1()
dim ws as worksheet
dim monnbre as byte
ca = Format(Sheets("Vierge").Cells(118, 2), "dd_mm_yy")
for each ws in worksheets
if left(ws.name,8)=ca then monNbre=monnbre+1
next
if monnbre>0 then ca=ca & "_" & monnbre
Evenement2 (ca)
End Sub


Edit : Oups excuse Hervé pas raffraichi
Loulou a 2 possibilités ainsi
Bonne journée à toi
 
Vote positif 0 Vote négatif
Re : Saiise de Jour identique

Bonjour à tous
J'ai modifier ton code et ajouter une fonction
Attention j'ai modifier des chose qui ne concernaient pas le problème

Dim ca
Sub Evenement2(ByVal nom As String)

' maj le 26/09/2006 CAMPELLO Hervé 233534

Sheets("Vierge").Select
Sheets("Vierge").Copy after:=Sheets("Vierge")
Sheets("Vierge (2)").Select
While ActiveSheet.Shapes.Count - 1 > 0
i = ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Delete
Wend

Sheets("Vierge (2)").Name = test(ca)
Range("a2").Select
Sheets("Vierge").Select
'Call Miseazero
'MsgBox "La nouvelle feuille de " & Sheets("Vierge").Cells(2, 14) & " est prête"
'Sheets("Param").Select
'F = Cells(2, 9).Value
'LienCellule (F)
'
End Sub

Sub Evenement1()
ca = Format(Sheets("Vierge").Cells(1, 2), "dd_mm_yy") 'Modification de la cellule à remettre pour topn appli
Evenement2 (ca)
End Sub
Function test(d)
b = d
k = 0
While k = 0
k = 1
For Each i In Sheets

c = 0
If i.Name = b Then
k = 0
n = Len(b) - InStrRev(b, ".", -1)
If n = 8 Then
c = 1
Else
c = Val(Right(b, n)) + 1
End If
b = ca & "." & c
Exit For

End If
Next


Wend
test = b

End Function
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

P
  • Question Question
XL 2010 Recopie de la date du jour jusqu'à la dernière ligne non vide
Réponses
5
Affichages
181
philmaure
P
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
820
KRUG WOO
K
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
948
marie3107
M
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
3 K
AtTheOne
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
1 K
jeff1494
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
1 K
Nico2978
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
4 K
sylvanu
  • Question Question
Microsoft 365 Erreur d'exécution 5 argument ou appel de procédure incorrect avec ActiveSheet.ChartObjects.Add()
Réponses
12
Affichages
964
pmfontaine
H
  • Question Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
872
HANN
H
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
4 K
fanou06
F
U
  • Question Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
754
un internaute
U
G
  • Résolu(e)
XL 2016 VBA : Copie d'une ligne après application d'un filtre
Réponses
7
Affichages
1 K
gfgghbhg
G
A
  • Question Question
XL 2010 Tri sur Date
Réponses
4
Affichages
881
Aldonanou
A
M
  • Question Question
XL 2016 Impression d'un rapport PDF depuis une URL avec VBA
Réponses
3
Affichages
1 K
mrcooll
M
M
  • Question Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
2 K
macseb
M
M
  • Résolu(e)
Microsoft 365 Décalage de ligne lors de la saisie
2 3
Réponses
37
Affichages
2 K
Marvin57
M
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
2 K
un internaute
U
S
  • Question Question
Microsoft 365 Mise à Jour dates
Réponses
0
Affichages
650
Stephane Mex
S
B
  • Question Question
Microsoft 365 2 macros de copie
Réponses
9
Affichages
1 K
Softmama
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…