Macro ne fonctionne plus sous 2013

**AlexB11** · 09/03/2016, 15h02

Bonjour,

J'ai un fichier avec une macro qui permettait de faire plusieurs choses (fusion de plusieurs fichiers, remplacement des caractères spéciaux par des caractères sans accent..) qui fonctionne très bien sous excel 2010 mais qui ne passe plus dans excel 2013.
Je ne suis pas développeur et manque de budget pour faire appel à un free lance pour quelque chose qui n'est peut-être pas compliqué.
Est-ce que l'un(e) d'entre vous pourrait me dire s'il faut faire réécrire le script de A à Z ou s'il peut être réparé facilement et rapidement svp ?

Je colle la fonction ci-dessous, merci par avance à celles et ceux qui pourront m'aider,

Alex

_________________________________________________________________________________________________________________

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Sub Bouton1_Clic()
    Dim strCheminCourant As String
    Dim xlApp As New Excel.Application
    Dim xlSheet As Worksheet
    Dim i As Integer
    Dim ctlBouton As Shape
 
    Const cstAmericas = "americas"
    Const cstAspac = "aspac"
    Const cstEmoa = "emoa"
 
    On Error GoTo err_fctButon
 
    strCheminCourant = ThisWorkbook.Path & "\"
 
    Call fctCopieDonnees(cstAmericas, strCheminCourant)
    Call fctCopieDonnees(cstAspac, strCheminCourant)
    Call fctCopieDonnees(cstEmoa, strCheminCourant)
 
    ' création d'un classeur dans lequel je copie mes feuilles actuelles
    ' pour obtenir un classeur sans macro
    Set xlBook = Workbooks.Add
    For i = 1 To ThisWorkbook.Sheets.Count
        ThisWorkbook.Sheets(i).Copy after:=xlBook.Sheets(xlBook.Sheets.Count)
    Next i
 
    ' je supprime les feuilles creees par defaut
    Application.DisplayAlerts = False
    For Each xlSheet In xlBook.Worksheets
        If xlSheet.Name <> cstAmericas And xlSheet.Name <> cstAspac And xlSheet.Name <> cstEmoa Then
            xlSheet.Delete
        End If
    Next
    Application.DisplayAlerts = True
 
    ' je supprime le bouton de lancement
    Sheets(cstAmericas).Select
    For Each ctlBouton In ActiveSheet.Shapes
        ctlBouton.Delete
    Next
 
'    ' masquage des colonnes
'    Columns("L:L").Select
'    Selection.EntireColumn.Hidden = True
'    Columns("M:M").Select
'    Selection.EntireColumn.Hidden = True
 
    ' sauvegarde du fichier sans macro
    xlBook.SaveAs (strCheminCourant & "Consolidation BOD 2010")
 
    Call MsgBox("Génération terminée.", vbInformation)
 
    ' je ferme le classeur source sans sauvegarde
    ThisWorkbook.Close savechanges:=False
 
Exit Sub
 
err_fctButon:
    If Err.Number = 1004 Then
        ThisWorkbook.Close savechanges:=False
    Else
        MsgBox Err.Description
    End If
End Sub
 
Private Function fctCopieDonnees(strRegion As String, strCheminCourant As String)
Dim xlApp As New Excel.Application
Dim xlBookSource As Workbook
Dim xlSheetSource As Excel.Worksheet
Dim tabFichiers() As String
Dim strFichier As String
Dim intNbLignes As Integer
Dim intLignePourColler As Integer
Dim i As Integer
Dim intNbFichiers As Integer
 
On Error GoTo err_fctCopieDonnees
    intNbLignes = 0
    ReDim tabFichiers(1)
    i = 0
    intLignePourColler = 2
 
    ' test si le sous-dossier
    If fctVerifDossier(strCheminCourant & strRegion) Then
        ' parcourir le dossier et retrouver la liste des fichiers que je stocke dans un tableau
        strFichier = Dir(strCheminCourant & strRegion & "\*.xls", 16)
        Do
            If strFichier = "" Then
                Exit Do
            Else
                tabFichiers(i) = strFichier
                i = i + 1
                ReDim Preserve tabFichiers(i)
            End If
            strFichier = Dir
        Loop
 
        intNbFichiers = i
 
        ' pour chacun des fichiers
        For i = 0 To intNbFichiers - 1
            Set xlBookSource = xlApp.Workbooks.Open(strCheminCourant & strRegion & "\" & tabFichiers(i))
            For Each xlSheetSource In xlBookSource.Sheets
                ' copie des donnees de chaque feuille
                xlSheetSource.Activate
                xlSheetSource.Range("A2").Select
                intNbLignes = xlSheetSource.Range("A65536").End(xlUp).Row
                xlSheetSource.Range("A2:M" & intNbLignes).Select
                xlApp.Selection.Copy
 
                ' je colle les donnees
                ActiveWorkbook.Sheets(strRegion).Select
                ActiveWorkbook.Sheets(strRegion).Range("A" & intLignePourColler).Select
                ActiveWorkbook.Sheets(strRegion).Paste
                intLignePourColler = intLignePourColler + intNbLignes - 1
            Next xlSheetSource
 
            ' comme la fermeture sans vider presse papier pose pb lorsque celui-ci contient bcp de donnees
            ' je copie seulement une petite zone pour ecraser le PP courant puis ferme le classeur
            Range("A1").Select
            Selection.Copy
            xlBookSource.Close
        Next i
    End If
 
    ' masquage des colonnes
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
 
    ActiveWorkbook.Sheets(strRegion).Range("A1").Select
 
Exit Function
 
err_fctCopieDonnees:
    xlApp.Quit
    Set xlApp = Nothing
 
End Function
 
Private Function fctVerifDossier(strDossier As String) As Boolean
 
    If Dir(strDossier, vbDirectory) <> "" Then
        fctVerifDossier = True
    Else
        fctVerifDossier = False
    End If
 
End Function

_________________________________________________________________________________________________

**parmi** · 09/03/2016, 15h33

Bonjour,

Je ne sais pas pourquoi le code passe par des objets Excel.Application... ce qui n'est pas nécessaire

Je commencerais par mettre les variables objets à Nothing avant de sortir de la Sub et de quitter l'application créée.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Bouton1_Clic()
 Dim strCheminCourant As String
 Dim xlApp As New Excel.Application
 Dim xlSheet As Worksheet
 
'..........
Set xlSheet = Nothing
Set xlApp = Nothing
xlApp.Quit
 
Exit sub
'...
End sub

Même chose pour l'autre Sub

Plutôt que

' comme la fermeture sans vider presse papier pose pb lorsque celui-ci contient bcp de donnees
' je copie seulement une petite zone pour ecraser le PP courant puis ferme le classeur
Range("A1").Select
Selection.Copy
xlBookSource.Close
Next i
End If

Je mettrais

Code :

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

Application.CutCopyMode = False

Plutôt que

For Each xlSheetSource In xlBookSource.Sheets
' copie des donnees de chaque feuille
xlSheetSource.Activate
xlSheetSource.Range("A2").Select
intNbLignes = xlSheetSource.Range("A65536").End(xlUp).Row
xlSheetSource.Range("A2:M" & intNbLignes).Select
xlApp.Selection.Copy

' je colle les donnees
ActiveWorkbook.Sheets(strRegion).Select
ActiveWorkbook.Sheets(strRegion).Range("A" & intLignePourColler).Select
ActiveWorkbook.Sheets(strRegion).Paste
intLignePourColler = intLignePourColler + intNbLignes - 1
Next xlSheetSource

je ferais

Code :

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

1
2
3
4
5
6
For Each xlSheetSource In xlBookSource.Sheets
 ' copie des donnees de chaque feuille
  intNbLignes = xlSheetSource.Range("A65536").End(xlUp).Row
 xlSheetSource.Range("A2:M" & intNbLignes).Copy ActiveWorkbook.Sheets(strRegion).Range("A" & intLignePourColler)
 intLignePourColler = intLignePourColler + intNbLignes - 1
 Next xlSheetSource

Finalement, je déclarerais les lignes en Long plutôt que Integer

Dim intNbLignes As Integer
Dim intLignePourColler As Integer

PS: quand tu mets du code, utilise le bouton # en haut de la fenêtre de message pour formater ton code

**parmi** · 09/03/2016, 15h44

Je viens de penser à autre chose...
Comme le programme utilise des variables Application, il se pourrait fort bien qu'il y ait un problème au niveau de la version dans les références.

Dans l'IDE VBA, va dans le menu Outils / Références et vérifie l'état de celles-ci.
Il faudra peut-être que tu décoches la version antérieur d'Excel et cocher la version actuelle

**AlexB11** · 09/03/2016, 17h15

Bonjour Parmi,

Merci pour le temps que tu as passé sur mon problème, mais je n'ai vraiment pas le niveau d'un dev pour bien comprendre tes indications, et de plus, j'ai vu que j'ai encore 2 fonctions derrière celle-ci, donc je ne sais pas si c'est dans ce script qu'il y a le problème.

Je vais me débrouiller pour trouver du budget et demander à un free-lance de me refaire un fichier from scratch car d'après ce que tu me dis, il y a des incohérences, et quitte à payer, autant avoir un rendu propre.

Encore merci pour ton aide,

Alex

**parmi** · 09/03/2016, 17h18

As-tu regardé le références du projet dans l'IDE de VBA ?
C'est peut-être là le seul le problème réel... même si un peu de ménage ne pourrait faire de tort...

**AlexB11** · 09/03/2016, 18h08

J'ai regardé mais n'ai pas vu de version excel dedans ou alors je ne sais pas quoi chercher.

Seuls sont cochés :
Visual Basic for Applications
Microsoft Excel 15.0 Object Library
OLE Automation
Microsoft Office 15.0 Object Library

Je vais faire refaire un fichier propre, ce sera plus simple.

Merci,

Alex

Macro ne fonctionne plus sous 2013 [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager