Discussion :

[Benjycool]

Bonjour,

A partir d'une feuille excel je voudrais exporter le contenu vers un autre fichier excel.

J'ai une liste non ordonnée de locaux avec des switch.
Les locaux ne sont pas specialement l'un apres l'autre, exemple un local peut etre mentionné au début, et je peux le retrouver a mi chemin.
Un autre :
Au debut j'ai le LocalName = SZ36I et le SwitchName = SZW600 donc je crée la feuille (dans le classeur 2) nommée SZ36I avec a la ligne 3 la valeur SZW600.
Ensuite ligne d'apres (classeur 1), j'ai LocalName = SZ28U et le SwitchName = SZW234 donc je crée la feuille (dans le classeur 2) nommée SZ28U avec a la ligne 3 la valeur SZW234.
Apres, j'ai encore le LocalName = SZ36I mais avec le SwitchName = SZW768, donc là, la ligne dispo est la 8 c'est ici que je devrais inserer le switch.

Et la j'ai une erreur :

erreur '1004' :
erreur définie par l'aplication ou par l'objet

Donc en fait a chaque fois que je reviens sur un onglet deja créer il bug lors de la fusion ...

Code ppl :

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
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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
        '* avant et apres car dans le tableau le switch commence par un espace
        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, dbt_tab_switch, fin_tab_switch)
 
            proc = create_switch(cl2, LocalName, SwitchName, dbt_tab_switch, fin_tab_switch)
 
 
        End If
 
 
    Next i
 
    For Each objFeuille In cl2.Sheets
      If objFeuille.Name Like "Feuil*" Then
 
        Application.DisplayAlerts = False
        objFeuille.Delete
        Application.DisplayAlerts = True
 
      End If
    Next
 
 
 
End Sub

Et les fonctions :

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
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
'|||||||| CREATION LOCAUX ||||||||
 
Public Function create_locaux(ByRef cl2 As Excel.Workbook, ByVal LocalName As String, ByVal SwitchName As String, ByVal dbt_tab_switch As Integer, ByVal fin_tab_switch As Integer)
 
    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 et chwas2
    'et que le LocalName n'est pas vide
    If ((FeuilleExiste = False) And (SwitchName <> " swzas1") And (SwitchName <> " swzas2")) And (LocalName <> "") Then
 
        'création de la feuille
        cl2.Sheets.Add
 
        'renomme la feuille
        cl2.ActiveSheet.Name = LocalName
 
    End If
 
End Function
'|||||||| FIN CREATION LOCAUX ||||||||
 
 
 
'|||||||| CREATION SWITCH ||||||||
 
Public Function create_switch(ByRef cl2 As Excel.Workbook, ByVal LocalName As String, ByVal SwitchName As String, ByVal dbt_tab_switch As Integer, ByVal fin_tab_switch As Integer)
 
    Dim f2 As Worksheet
 
    Set f2 = cl2.Sheets(LocalName)
 
    'calcul de la premiere ligne dispo pour inserer le switch
    For l = 3 To 103 Step 5
 
        If (f2.Cells(l, 2) = "") Then
 
            ligne1 = l
            l = 103
 
        End If
 
    Next l
 
            'fusion de la première ligne disponible du switch (pour son nom)
            f2.Range(Cells(ligne1, 2), Cells(ligne1, 27)).Select
            With Selection
                .MergeCells = True
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Value = SwitchName
            End With
 
End Function

Aidez moi !! Il me reste que ca pour finir mon projet ...

Cordialement

Benjamin