J'ai honte

[Bruno]

Re -re -bonjour a tous

Suite a mon post "Logique ou programation" de 14:48 j'ai trouvé une astuce minable pour faire fonctionner mon prog en attendant mieux.

Il suffit de faire:

Dim n As Integer
Dim I As Integer
Dim Compteur As Integer
n = Sheets.Count

For I = 1 To n Step 1
On Error GoTo astuce
If Not Sheets("Lg." & I) Is Nothing Then Compteur = I
Next I

astuce:
Sheets("Nomenclature").Select
Sheets.Add
ActiveSheet.Name = "Lg." & (Compteur + 1)
Sheets("Modèle Lg").Cells.Copy
Sheets("Lg." & (Compteur + 1)).Select
ActiveSheet.Paste
Range("A1").Select

Et pareil pour les feuilles Calcul

J'ai réellement honte de devoir utiliser des bidouilles pareilles alors si quelqu'un peut me donner une solution plus propre... MERCI

Que la force soit avec XLD

Bruno

 

[Ti]

Re: J'ai honte -mais un moment de honte est vite passé

Voilà comment je m'y serais pris pour renvoyer automatiquement des noms de feuilles incrémentés :

Option Explicit
'Ti 29/07/03

Private Function NouveauNom(NomFeuille As String) As String
Dim Ws As Worksheet, Nom As String
Dim Numero As Byte, Indice As Byte, Max As Byte

For Each Ws In ThisWorkbook.Worksheets
Indice = 0
If InStr(1, Ws.Name, NomFeuille, vbTextCompare) > 0 Then

Do While IsNumeric(Right(Ws.Name, Indice + 1))
Indice = Indice + 1
Loop
If Indice > 0 Then Numero = Right(Ws.Name, Indice)
If Numero > Max Then Max = Numero
End If
Next Ws
NouveauNom = NomFeuille & Max + 1
End Function

Sub AjoutLg()
Dim Ws As Worksheet

Set Ws = ThisWorkbook.Sheets.Add
With Ws
.Name = NouveauNom("Lg")
Sheets("Modèle Lg").Cells.Copy .Range("A1")
End With
End Sub

Sub AjoutCalcul()
Dim Ws As Worksheet

Set Ws = ThisWorkbook.Sheets.Add
With Ws
.Name = NouveauNom("Calcul")
'Sheets("Modèle Lg").Cells.Copy .Range("A1")
'Sheets("Lg." & (P + 1)).Select
End With
End Sub

 

[sousou]

Si cela te plait mieux tu peux t'inspirer de la manière.

la macro crelg() crée des feuilles lg suivies d'un numéro d'ordre
la macro creca() crée des feuilles ca......

la macro test() détermine le numéro d'ordre
Tu peux ainsi avoir autant de type de feuille que tu veux, et surtout ne pas être géné par les autres .

A suivre.

Dim comptlg, comptca
Sub crelg()
test
Worksheets.Add
ActiveSheet.Name = "lg" & comptlg
End Sub
Sub creca()
test
Worksheets.Add
ActiveSheet.Name = "ca" & comptca
End Sub
Sub test()
comptlg = 0
comptca = 0
For Each f In Worksheets
If Left(f.Name, 2) = "lg" Then comptlg = comptlg + 1
If Left(f.Name, 2) = "ca" Then comptca = comptca + 1
Next
End Sub

 

[Bruno]

Merci a tous les deux c'est terrible....

@+