Discussion :

[Wynelle]

Bonjour à tous,

Je profite de ce mail pour remercier tous les "experts" qui contribuent à ce site car j'avoue y avoir trouver beaucoup beaucoup d'infos pour construire quelques unes des macros que j'utilise. Vous l'aurez compris, je bidouille de manière empirique. Merci pour votre indulgence.

Je coince sur un problème depuis le début du weekend et malgré un nombre incalculable de tentative, rien n'y fait et cela finit par me taper sur les nerfs! J'espère que vous pourrez m'aider (... j'en suis sûr!).

Mon problème : J'ai une macro qui sélectionne les 16 1ères feuilles d'un classeur (qui en contient en général 35/40) pour les enregistrer dans un nouveau classeur qui prendra le nom du 16ième onglets (ramené en 1ère position). Les 15 1ères sont toujours les mêmes mais le nom de la 16 ième varie à chaque fois. La macro fonctionne bien s/le 1er tour mais bloque à la deuxième boucle au niveau de la sélection des pages via MyArray().

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
Sub b_TRIER_ONGLETS_et_SAVE_AS()
 
Application.ScreenUpdating = False
 
Dim boucle As Integer 'définition de la boucle de répétition
Dim NomOnglet As String
 
boucle = ThisWorkbook.Sheets.Count 'comptage nbre total onglets
Nbr_Onglets = boucle - 15 'comptage nbre kyc créé
 
Do Until Nbr_Onglets = 0 'boucle active tant que Nbr_Onglets > 0
 
    NomOnglet = Sheets(16).name
    MsgBox "Nom du classeur à créer : " & NomOnglet
 
    Dim WB1 As Workbook
    Dim MyArray() As String
    Dim i As Integer, X As Byte
 
    Set WB1 = ThisWorkbook
 
    For i = 1 To 16
        ReDim Preserve MyArray(X)
        MyArray(X) = Sheets(i).name
        X = X + 1
    Next
 
    WB1.Worksheets(MyArray).Copy '<==== le problème vient de là au second tour!!!
 
    Sheets(16).Move Before:=Sheets(1)
    SendKeys ("{ENTER}")    'Evite d'avoir le message de confirmation
    Sheets(Array("Liste", "Départ", "KYC Form")).Delete 'Efface les onglets inutiles
    Sheets(Array(2, 4, 6, 8, 9, 10)).Visible = False 'Masque les onglets
    Sheets(1).Activate
 
Dim Chemin As String, NomFichier As String
Dim Extension As String
 
  Extension = ".xlsm"
  Chemin = "D:\XBOAO_v2\Fiches OK\" 'indiquer le chemin pour enregistrer sous
 
  On Error GoTo 0
  NomFichier = Sheets(1).name & Extension
      With ActiveWorkbook
        .SaveAs Filename:=Chemin & NomFichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .Close
        SendKeys ("{ENTER}")    'Evite d'avoir le message de confirmation
        Sheets(16).Delete  'Efface onglet traité
    End With
 
  Sheets("Départ").Range("A1:A4").Activate
 
  Sheets("Départ").Shapes("Image 3").Visible = True
  Sheets("Départ").Shapes("Image 6").Visible = True
 
Loop 'rebouclage
 
End Sub

Merci d'avance pour votre aide.

Cdt / Wynelle

[SfJ5Rpw8]

Bonjour,

comment ce manifeste ce blocage d'Array ?

Ou remet-tu X à 0 ?

[Wynelle]

Whaou, une réponse dans la seconde... c'est dingue

J'ai un message d'erreur d'exécution "9", l'indice n'appartient pas à la sélection.

Je ne remet pas X à 0 à la fin de la 1ère exécution.
Je vais essayer.

[Wynelle]

Yes, ça marche

Un super grand merci à BBIL car on ne voit même plus les évidences lorsque l'on fait une fixette dessus.
Génial.

Bonne continuation à tous.

[joe.levrai]

Bonjour,

tu peux éviter de valider la toucher Enter avec SendKeys (qui est à éviter quand on le peut)

l'instruction Application.DisplayAlerts permet de ne pas afficher les messages de confirmation/avertissement, en le faisant valider automatiquement sur le choix par défaut

ce qui permet de supprimer tes onglets sans message

Code :

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

1
2
3
Application.DisplayAlerts = False
Sheets(Array("Liste", "Départ", "KYC Form")).Delete 'Efface les onglets inutiles
Application.DisplayAlerts = True

je te conseille également de toujours déclarer tes variables au début de procédure, plutôt que d'avoir des "Dim xxx" durant la procédure
ça facilite la relecture et la compréhension du code

[Theze]

Bonjour,

Je n'ai absolument rien testé mais je verrai plutôt le code comme ce qui suit par contre, je ne vois absolument pas la nécessité de la boucle Do Loop ? :

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
 
Sub b_TRIER_ONGLETS_et_SAVE_AS()
 
    Dim WB1 As Workbook
    Dim WB2 As Workbook
    Dim MyArray() As String
    Dim NomOnglet As String
    Dim Chemin As String
    Dim NomFichier As String
    Dim I As Integer
 
    With Application
 
        .ScreenUpdating = False
 
        Set WB1 = ThisWorkbook
 
        NomOnglet = Sheets(16).Name
        MsgBox "Nom du classeur à créer : " & NomOnglet
 
        For I = 1 To 16
 
            ReDim Preserve MyArray(1 To I)
            MyArray(I) = Sheets(I).Name
 
        Next
 
        .DisplayAlerts = False
        Sheets(Array("Liste", "Départ", "KYC Form")).Delete 'Efface les onglets inutiles
 
        WB1.Worksheets(MyArray).Copy
 
        Set WB2 = ActiveWorkbook
 
        With WB2
 
            .Sheets(16).Move Before:=Sheets(1)
            .Sheets(Array(2, 4, 6, 8, 9, 10)).Visible = False
 
            Chemin = "D:\XBOAO_v2\Fiches OK\" 'indiquer le chemin pour enregistrer sous
            NomFichier = .Sheets(1).Name & ".xlsm"
 
            .SaveAs Chemin & NomFichier
            .Close
 
        End With
 
        With WB1
 
            .Sheets(16).Delete  'Efface onglet traité
 
            .Sheets("Départ").Range("A1:A4").Select
 
            .Sheets("Départ").Shapes("Image 3").Visible = True
            .Sheets("Départ").Shapes("Image 6").Visible = True
 
        End With
 
        .DisplayAlerts = True
        .ScreenUpdating = True
 
    End With
 
End Sub

Hervé.