Création de feuille dans un autre classeur : erreur '1004'
Bonjour,
J'ai un gros soucis, je suis en stage actuellement et je dois à partir d'une feuille excel, trier et exporter les switch et locaux vers un autre classeur.
Mais lorsque je veux créer les feuilles (qui represente les locaux du classeur 1) dans le classeur 2 (une feuille par locaux) il me le fait nikel mais il m'affiche une erreur :
Citation:
erreur '1004' :
erreur définie par l'aplication ou par l'objet
A la fin de mon tableau j'ai deux switch qui n'ont pas de locaux swzas1 et swzas2 d'ou ma condition dans la fonction.
Enfin voila, je ne vois pas du tout pourquoi il bug, je pense que ca vient de la fonction mais apres ...
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
| Private Sub export_Click()
Dim cl1 As Workbook, cl2 As Workbook
Dim f1 As Worksheet
Set cl1 = ActiveWorkbook
Set f1 = cl1.Worksheets("Etat Switch")
Dim Fichier As String, nomclasseur As String
'ajoute un nouveau classeur
Application.Workbooks.Add
'nomme ton classeur
nomclasseur = Format(Date, "DD-MM-YYYY") & "-" & "Etat_Switch"
'donne le chemin et l'extension du fichier
Fichier = "C:\User\...\Documents\Stagiaire_POUCET\Switch\" & nomclasseur & ".xls"
'sauvegarde le nouveau fichier
ActiveWorkbook.SaveAs Fichier
Set cl2 = ActiveWorkbook
'fais le tour du tableau pour trouver tout les switch de tout les locaux
For i = 1 To 5000
'si c'est un switch prend la première et tout le reste ce fait à partir de cette première ligne
If f1.Cells(i, 3).Value Like "*swz*" Then
SwitchName = f1.Cells(i, 3).Value
LocalName = f1.Cells(i, 2).Value
dbt_tab_switch = i
'depuis le premier local trouver la ligne de fin du switch
For j = dbt_tab_switch To dbt_tab_switch + 55
'si on arrive sur une ligne blanche mais que les ports du switch sont encore present apres la separation
If ((f1.Cells(j, 3) = "") And (f1.Cells(j + 3, 2) = LocalName) And (f1.Cells(j + 3, 4) = "FA")) Then
j = j + 2
'sinon si le nom est différent du switch ou qu'apres la separation c'est un autre switch le tableau est fini
ElseIf ((f1.Cells(j, 3) <> SwitchName) Or ((f1.Cells(j, 3) = "") And ((f1.Cells(j + 4, 2) <> SwitchName) Or (f1.Cells(j + 4, 4) <> "FA")))) Then
fin_tab_switch = j - 1
j = dbt_tab_switch + 55
End If
Next j
'pour donner à i la debut du prochain switch
'si il y a une sépération (3 ligne entre chaque séparation i recoit i + les trois lignes
If ((f1.Cells(fin_tab_switch + 1, 3) = "") And (f1.Cells(fin_tab_switch + 3, 3) <> "")) Then
i = fin_tab_switch + 3
'sinon si le tableau commence la ligne d'apres
ElseIf (f1.Cells(fin_tab_switch + 1, 3) <> "") Then
i = fin_tab_switch + 1
'sinon c'est que le tableau de tout les switch est fini
Else: i = 5000
End If
'ICI POUR LA CREATION DES LOCAUX
proc = create_locaux(cl2, LocalName, SwitchName)
End If
Next i
End Sub |
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
|
'CREATION DES LOCAUX
Public Function create_locaux(cl2, LocalName, SwitchName)
FeuilleExiste = False
For Each objFeuille In cl2.Sheets
If objFeuille.Name = LocalName Then
FeuilleExiste = True
Exit For
End If
Next
'si le local n'existe pas on le crée sauf pour la colonne du switch chwas1
If ((FeuilleExiste = False) And (SwitchName <> " swzas1") And (SwitchName <> " swzas2")) Then
'création de la feuille
cl2.Sheets.Add
'renomme la feuille
cl2.ActiveSheet.Name = LocalName
MsgBox LocalName & SwitchName & " i= " & i
End If
For Each objFeuille In cl2.Sheets
If objFeuille.Name Like "Feuil*" Then
Application.DisplayAlerts = False
objFeuille.Delete
Application.DisplayAlerts = True
End If
Next
End Function |
Merci de bien vouloir m'aider
Cordialement
Benjamin