Discussion :

[bmeda72]

Bonjour à tous,

Quelqu'un pourrait il m'aider à incrémenter un compteur à chaque fois qu'un nouveau classeur est créer.

Une idée des choses. J'ai un projet qui me génère des résultats de calculs que j'aimerais sauver dans plusieurs classeurs. Tels que: Result1, Result2, Result3 etc.. Les noms Result1 sont dans la colonne A1 d'un worksheet

J'ai écris une procédure qui me permet d'ajouter et de sauver le premier (Result1) mais pour la suite je ne sais pas comment incrémenter le compteur.

Merci bien pour votre aide

[Montor]

une macro complimentaire

[Invité]

Bonjour,

Vous pouvez aussi ajouter ce code dans votre procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
With Sheets("Feuil1")
dl = .Range("A65536").End(xlUp).Row
nbc = Len(.Cells(dl, 1))
num = Val(Right(.Cells(dl, 1), nbc - 6)) + 1
nom = "RESULT" & num
.Cells(dl + 1, 1) = nom
End With

Vous utilisez la variable "nom" pour enregistrer votre fichier.

[bmeda72]

merci delphidelphi
Avec une petite reflexion, j'ai trouvé une solution partielle à mon problème, voici ce que j'ai fait comme code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub AjoutNouveau()
 
Dim i As Integer, Nom As String
Dim Newbook As Workbook
 
With ThisWorkbook.Worksheets("feuil1")
    .Range("b1").Value = .Range("b1").Value + 1
    i = .Range("B1").Value
End With
 
Nom = "Resultats Calcul" & i & ".xls"
ThisWorkbook.Worksheets("feuil1").Cells(1, 1) = Nom
 
On Error Resume Next
Set Newbook = Workbooks.Add(xlWBATWorksheet)
 
On Error Resume Next
    With Newbook
        .Title = "Resultats Calcul"
        .Subject = "Resultats"
        .SaveAs Filename:=Nom
    End With
End Sub

il fonctionne correctement. Je veux maintenant ajouter de nouvelles feuilles à ce classeur creé. J'avais ceci avant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub ajoutfeuille()
             Workbooks("Resultats Calcul").Worksheets.Add after:=Worksheets(Worksheets.Count)
 End Sub

Mais comme Resultats calcul prends maintenant Resultats Calcul1; Resultats Calcul2 etc il reste à gerer cette modif.

Jacques j'ai pas bien compris ton code, il resemble à celui que j'ai fait.

[Invité]

Bien sûr que ça se ressemble à part le fait que j'ai utilisé ce que vous aviez écrit au départ :

Les noms Result1 sont dans la colonne A1 d'un worksheet

C'est pourquoi j'extraie le numéro.

Mais le principal est que votre code fonctionne.

[Montor]

Bonjour mets ce code dans un module de class Classe1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Option Explicit
Public WithEvents App As Application
Private Sub App_NewWorkbook(ByVal Wb As Workbook)
If Wb.Name <> ThisWorkbook.Name Then
MsgBox "un nouveau classeur sera ceer"
End If
End Sub

et dans l'evenement thisworkbook Workbook_Open() mets ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Option Explicit
Dim X As New Classe1
Private Sub Workbook_Open()
Set X.App = Application
End Sub

enregistre le fichier comme une macro complementaire .xla ou xlam et redemarrer l'application
Votre projet doit avoir une certificat pour fonctionner correctement

[bmeda72]

Merci bien pour vos contributions

c'est correcte, la procédure fonctionne bien.