Problème de Macro à l'ouverture du classeur

**Tibodep** · 23/09/2016, 11h49

Bonjour,

J'ai tenté d'utiliser une macro à l'ouverture de mon classeur et je ne comprends pas pourquoi mais sur certaines lignes le comportement est un peu différent de quand je la lance dans un module.

Je m'explique : le code fonctionne sans bug mais certaines instructions s'appliquent sur le classeur que j'ouvre et non sur la base de donnée que je veux mettre en forme. Par ailleurs les lignes sheets...select et Windows...activate me renvoient des erreurs !

Voici le code :

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
Private Sub workbook_open()
 
    Dim nbl As Variant
 
 
    Workbooks.Open Filename:="J:\Siege\8. Immo Orga\32. Rapprochement Comptable\6. Suivi\Export_TOTAL.xlsx"
 
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
 
    nbl = Range("C1").SpecialCells(xlCellTypeLastCell).Row - 2
    MsgBox nbl
 
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "DR"
 
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[6],2))"
    Selection.AutoFill Destination:=Range("A2:A" & nbl)
 
    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Columns("A:A").Select
    Selection.Replace What:="74", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    Columns("B:B").Select
    Selection.TextToColumns
 
    Range("E:L,O:AA").Select
    Selection.Delete Shift:=xlToLeft
 
    ActiveSheet.Range("$A$1:$AA$" & nbl).AutoFilter Field:=4, Criteria1:=Array( _
        "Démolition/Reconstruction", "Ouverture", "Transfert"), Operator:= _
        xlFilterValues
 
    Range("A2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
 
    Windows("Suivi des Rapprochements.xlsm").Activate
    Sheets("EXPORT TOTAL").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
End Sub

Auriez-vous des idées car je n'utilise pas souvent ce type de macro appliquée sur des feuilles ou classeurs...

Merci d'avance pour vos réponses

**Tibodep** · 23/09/2016, 11h51

NB : c'est le code pour flitrer qui pose ici problème

Code :

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

1
2
3
ActiveSheet.Range("$A$1:$AA$" & nbl).AutoFilter Field:=4, Criteria1:=Array( _
"Démolition/Reconstruction", "Ouverture", "Transfert"), Operator:= _
xlFilterValues

**Stanler** · 23/09/2016, 12h34

Bonjour,

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
Private Sub workbook_open()
 
    Dim nbl As Variant
 
 
    Workbooks.Open Filename:="J:\Siege\8. Immo Orga\32. Rapprochement Comptable\6. Suivi\Export_TOTAL.xlsx"
 'va cibler l'activeworkbook en cours + Select inutile
 '   Rows("1:2").Select  
 '   Selection.Delete Shift:=xlUp
Activeworkbook.Rows("1:2").Delete Shift:=xlUp
 
    nbl = Range("C1").SpecialCells(xlCellTypeLastCell).Row - 2 'Pourquoi -2 ?
    MsgBox nbl 'Pourquoi faire ?
 
'Idem 
    'Columns("A:A").Select
    'Selection.Insert Shift:=xlToRight
Activeworkbook.Activesheet.Columns("A:A").Insert Shift:=xlToRight
 
'Idem 
    'Range("A1").Select
    'ActiveCell.FormulaR1C1 = "DR"
Activeworkbook.Activesheet.Range("A1").Value = "DR"
 
'Idem 
    'Range("A2").Select
   ' ActiveCell.FormulaR1C1 = "=VALUE(LEFT(RC[6],2))"
   ' Selection.AutoFill Destination:=Range("A2:A" & nbl)
 
    Activeworkbook.Activesheet.Range("A2").FormulaR1C1 = "=VALUE(LEFT(RC[6],2))"
    Activeworkbook.ActivesheetRange("A2").AutoFill Destination:=Range("A2:A" & nbl)
 
'Idem 
 '   Columns("A:A").Select
 '   Selection.Copy
 '   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Activeworkbook.Activesheet.Columns("A:A").Copy
 
    Activeworkbook.Activesheet.Columns("A:A")..PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
'Idem 
  '  Columns("A:A").Select
  '  Selection.Replace What:="74", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    Columns("A:A").Select
    Columns("A:A").Replace What:="74", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
'Idem 
  '  Columns("B:B").Select
  '  Selection.TextToColumns
 
    Columns("B:B").TextToColumns
 
'Idem 
  '  Range("E:L,O:AA").Select
  '  Selection.Delete Shift:=xlToLeft
 
    Range("E:L,O:AA").Delete Shift:=xlToLeft
 
'Idem 
    Activeworkbook.Activesheet.Range("$A$1:$A$" & nbl).AutoFilter Field:=4, Criteria1:=Array( _
        "Démolition/Reconstruction", "Ouverture", "Transfert"), Operator:= _
        xlFilterValues
 
 
'Idem 
    'Range("A2:F2").Select
   ' Range(Selection, Selection.End(xlDown)).Select
   ' Selection.Copy
 
    Activeworkbook.Activesheet.Range(Range("A2:F2"), Range("A2:F2").End(xlDown)).Copy
 
 
   ' Windows("Suivi des Rapprochements.xlsm").Activate
   ' Sheets("EXPORT TOTAL").Select
   ' Range("A2").Select
   ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Workbook("Suivi des Rapprochements.xlsm").Sheets("EXPORT TOTAL").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
End Sub

Il y a surement quelques petites chose à adpter à ton besoin

**Tibodep** · 23/09/2016, 17h02

Merci pour tes conseils de syntaxe, je suis encore nouveau dans le domaine donc meaculpa pour les écritures trop lourdes !

Par contre > en appliquant ton code j'ai un bug que je n'avais pas avant (dés la deuxième ligne) et cela ne solutionne pas mon problème initial (le filtre s'effectue sur le fichier source et non dans la BDD) ....

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
Private Sub workbook_open()

    Dim nbl As Variant


    Workbooks.Open Filename:="J:\Siege\8. Immo Orga\32. Rapprochement Comptable\6. Suivi\Export_TOTAL.xlsx"
    
    ActiveWorkbook.Rows("1:2").Delete Shift:=xlUp
    
    nbl = Range("C1").SpecialCells(xlCellTypeLastCell).Row - 2
    MsgBox nbl
    
    ActiveWorkbook.ActiveSheet.Columns("A:A").Insert Shift:=xlToRight
    
    ActiveWorkbook.ActiveSheet.Range("A1").Value = "DR"
    
    ActiveWorkbook.ActiveSheet.Range("A2").FormulaR1C1 = "=VALUE(LEFT(RC[6],2))"
    
    ActiveWorkbook.ActivesheetRange("A2").AutoFill Destination:=Range("A2:A" & nbl)
    
    
    ActiveWorkbook.ActiveSheet.Columns("A:A").Copy
 
    ActiveWorkbook.ActiveSheet.Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
    Columns("A:A").Select
    Selection.Replace What:="74", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Columns("B:B").TextToColumns
    
    Range("E:L,O:AA").Delete Shift:=xlToLeft
    
   ActiveWorkbook.ActiveSheet.Range("$A$1:$A$" & nbl).AutoFilter Field:=4, Criteria1:=Array( _
        "Démolition/Reconstruction", "Ouverture", "Transfert"), Operator:= _
        xlFilterValues
    
    ActiveWorkbook.ActiveSheet.Range(Range("A2:F2"), Range("A2:F2").End(xlDown)).Copy
    
    Workbooks("Suivi des Rapprochements.xlsm").Sheets("EXPORT TOTAL").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
End Sub

**Stanler** · 23/09/2016, 17h10

Bonsoir,

Oui, c'est normal :

Code :

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

ActiveWorkbook.Rows("1:2").Delete Shift:=xlUp

doit être changé en :

Code :

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

ActiveWorkbook.ActiveSheet.Rows("1:2").Delete Shift:=xlUp

Tu aurais pu le déduire rien qu'en lisant mon précédent message. Je me permet de m'auto-citer :

Il y a surement quelques petites chose à adpter à ton besoin.

Je n'ai pas eu le temps de tester le code avant de te l'envoyer

Ton fichier source, c'est lequel ? (Nom du classeur + Nom de la feuille + Plage complète)
Ton fichier base de données, c'est lequel ? (Nom du classeur + Nom de la feuille + Plage complète)

Ton souci c'est que tu dois cibler ta zone pour l'action que tu souhaites réaliser. Ton code cible... Ce qui est actif, ce peut être source d'erreur surtout si tu as plusieurs classeurs ouverts.

**Tibodep** · 23/09/2016, 17h35

Effectivement après 8h d'Excel les yeux ne fonctionnent plus aussi bien ! En tout cas, j'avais pas mal d'erreurs dans la syntaxe et tes exemples vont me permettre de simplifier mes autres macros donc THX

Mon problème initiale venait en fait de ma ligne pour filtrer > plage non définie (fallait mettre A:F et non A:A) mais tu ne pouvais pas le deviner !

Maintenant ça fonctionne !

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
Private Sub workbook_open()

    Dim nbl As Variant


    Workbooks.Open Filename:="J:\Siege\8. Immo Orga\32. Rapprochement Comptable\6. Suivi\Export_TOTAL.xlsx"
    
    ActiveWorkbook.ActiveSheet.Rows("1:2").Delete Shift:=xlUp
    
    nbl = Range("C1").SpecialCells(xlCellTypeLastCell).Row - 2
    MsgBox nbl
    
    ActiveWorkbook.ActiveSheet.Columns("A:A").Insert Shift:=xlToRight
    
    ActiveWorkbook.ActiveSheet.Range("A1").Value = "DR"
    
    ActiveWorkbook.ActiveSheet.Range("A2").FormulaR1C1 = "=VALUE(LEFT(RC[6],2))"
    
    ActiveWorkbook.ActiveSheet.Range("A2").AutoFill Destination:=Range("A2:A" & nbl)
    
    
    ActiveWorkbook.ActiveSheet.Columns("A:A").Copy
 
    ActiveWorkbook.ActiveSheet.Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
    Columns("A:A").Select
    Selection.Replace What:="74", Replacement:="8", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    Columns("B:B").TextToColumns
    
    Range("E:L,O:AA").Delete Shift:=xlToLeft
    
    ActiveWorkbook.ActiveSheet.Range("$A$1:$F$" & nbl).AutoFilter Field:=4, Criteria1:=Array( _
        "Démolition/Reconstruction", "Ouverture", "Transfert"), Operator:= _
        xlFilterValues    

    ActiveWorkbook.ActiveSheet.Range(Range("A2:F2"), Range("A2:F2").End(xlDown)).Copy
    
    Workbooks("Suivi des Rapprochements_ODT.xlsm").Sheets("EXPORT TOTAL").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
End Sub

**Stanler** · 23/09/2016, 17h45

C'est un plaisir de faire plaisir

Bravo pour ton travail !

Problème de Macro à l'ouverture du classeur [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager