Discussion :

[aacmweb]

Bonjour


Je n'arrive plus à sauvegarder et à fermer mon fichier !
j'ai le message d'erreur :
Erreur d execution '424'
objet requis

le probleme vient peut etre du chemin "wb.path" mais ce que je voudrais c'est que mon macro puisse s'executer sur un autre PC de n'importe qui et n'importe quel dossier/sous-dossier

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
 
Sub Macro11()
'
' Macro11 Macro
'
Dim Wb As Workbook
Dim AnneeUS As String
Dim Fichier As String
Set Wb = ThisWorkbook
MsgBox " wb.path = " & Wb.Path
'
MsgBox " Debut de Module11 "
'
' Date du jour ( format US/ENG : aaaa mm jj
'
AnneeUS = Format(Now, "yyyy")
'
    '
    If FichierExiste(Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx") = False Then
       Workbooks.Add.SaveAs Filename:=Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx"
    Else
      MsgBox "Le fichier existe deja ! Verifier ! ==> Arret du PGM "
      GoTo FIN
    End If
    '
 
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Numero Compte"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "Libellé"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "Debit (en €)"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "Credit (en €)"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "Nature Operations"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "Relevé Banque Postale n°"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Details"
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "Type d'Operations"
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "Justificatif"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Somme Total :"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Sous-Total ( voir Filtre ) :"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:3").Select
    Selection.Font.Bold = True
    '
    Range("D1:D999").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("E1:E999").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    '
    ' ajout des forumles
    '
    Range("D1").Select
    ActiveCell.Formula = "=SUM(D3:D999)"
    Range("E1").Select
    ActiveCell.Formula = "=SUM(E3:E999)"
    '
    Range("D2").Select
    ActiveCell.Formula = "=SUBTOTAL(109,D3:D999)"
    Range("E2").Select
    ActiveCell.Formula = "=SUBTOTAL(109,E3:E999)"
     '
      Columns("A:A").Select
    Selection.ColumnWidth = 15
    Columns("B:B").Select
    Selection.ColumnWidth = 10
    Columns("C:C").Select
    Selection.ColumnWidth = 85
    Columns("D:D").Select
    Selection.ColumnWidth = 12
    Columns("E:E").Select
    Selection.ColumnWidth = 12
    Columns("F:F").Select
    Selection.ColumnWidth = 17
    Columns("G:G").Select
    Selection.ColumnWidth = 24
    Columns("H:H").Select
    Selection.ColumnWidth = 30
    Columns("I:I").Select
    Selection.ColumnWidth = 25
    Columns("J:J").Select
    Selection.ColumnWidth = 10
   '
   Range("A1").Select
 
   '
   'Fichier = Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx"
   'ThisWorkbook.SaveAs Fichier
   'Close (SaveChanges), Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx)"
   Workbook.SaveAs Filename:=Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx"
   'Workbooks(Wb.Path & "\" & AnneeUS & "_ANNEE_T_Compte.xlsx").Save
 
   '
  MsgBox " c'est fini !"
FIN:
 
End Sub
Public Function FichierExiste(MonFichier As String)
   If Len(Dir(MonFichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
End Function

Je suis sous Excel 2013 et windows 8.1
Merci d'avance et bonne soirée !