Macro ouverture Fichier puis enregistrement : Comment la simplifier ?

**mattwarend** · 21/11/2008, 09h13

Bonjour à tous,

J'utilise une macro pour ouvrir un fichier .txt, faire un mise en page, et sélectionner une ligne précise (emplacement UNC) :

Code :

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

1
2
3
4
Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\EUFRHQFS01WP\USERS\AUDIT",

puis enregistrer mon fichier modifié dans ce même emplacement :

Code :

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

1
2
3
4
5
6
 ChDir "H:\AUDIT\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="\\EUFRHQFS01WP\USERS\AUDIT\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True

Je souhaiterais maintenant pouvoir rendre cette macro adaptative (sur un autre serveur, avec d'autres emplacements).
Je ne sais pas du tout par où commencer ni comment procéder.

Voici mon code complet pour info.

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
 
Sub auto_open()
 ChDir "C:\Documents and Settings\admincot\Desktop"
    Workbooks.OpenText Filename:="\\eufrhqfs01wp\QUOTALOG\Usage.txt", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 1), _
        TrailingMinusNumbers:=True
    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
    Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\EUFRHQFS01WP\USERS\AUDIT", _
        Operator:=xlAnd
    Selection.ClearContents
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
If WorksheetFunction.CountA(Cells) = 0 Then
MsgBox "Feuille vide !"
Exit Sub
End If
With ActiveSheet.UsedRange
LastRow = .Cells(.Cells.Count).Row
End With
For R = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(R)) = 0 Then
Rows(R).Delete
End If
Next R
Range("A1:E2").Select
    Range("E2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
On Error Resume Next
    Range("A1:E1").Select
    Range("E1").Activate
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1").Select
        Application.DisplayAlerts = False
    ChDir "H:\AUDIT\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="H:\AUDIT\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True
 
 
    ChDir "C:\Documents and Settings\admincot\Desktop"
    Workbooks.OpenText Filename:="\\eufrhqfs01wp\QUOTALOG\Usage.txt", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 1), _
        TrailingMinusNumbers:=True
    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
    Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\EUFRHQFS01WP\USERS\COMPTA", _
        Operator:=xlAnd
    Selection.ClearContents
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
If WorksheetFunction.CountA(Cells) = 0 Then
MsgBox "Feuille vide !"
Exit Sub
End If
With ActiveSheet.UsedRange
LastRow = .Cells(.Cells.Count).Row
End With
For R = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(R)) = 0 Then
Rows(R).Delete
End If
Next R
Range("A1:E2").Select
    Range("E2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
On Error Resume Next
    Range("A1:E1").Select
    Range("E1").Activate
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1").Select
        Application.DisplayAlerts = False
    ChDir "H:\COMPTA\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="H:\COMPTA\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True
 
       Excel.Application.Quit
    End Sub

**decondelite** · 21/11/2008, 09h43

Je te suggère de regarder ces propriétés:
-Workbook.Path
-Workbook.FullName
-Workbook.Name

Voilà, je pense que ça devrait régler tes problèmes d'emplacement.

**mattwarend** · 21/11/2008, 10h50

Oh la la. Je vois pas trop...

**decondelite** · 21/11/2008, 11h02

Envoyé par decondelite

Je te suggère de regarder ces propriétés:
-Workbook.Path
-Workbook.FullName
-Workbook.Name

Voilà, je pense que ça devrait régler tes problèmes d'emplacement.

Ce sont les chemins d'accès de ton classeur, fais donc Workbooks("Mon classeur.xls") ou ThisWorkbook pour renvoyer un objet classeur, et tu rajoute derrière .Path etc... pour avoir les chemins d'accès, le nom, etc...

Macro ouverture Fichier puis enregistrement : Comment la simplifier ?

Macros et VBA Excel

Discussions similaires

Partager

Partager