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
151
152
153
154
155
156
157
158
|
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 01/06/2004 by Belair, Christian
'
'
Dim name As String
Dim currentname As String
Dim path As String
currentname = ActiveWorkbook.name
path = modUtilitaires.GetPath()
name = Dir(path)
Range("A1:A1").Select
Workbooks.Open Filename:=path
Cells.Select
selection.Copy
Windows(currentname).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Windows(name).Activate
ActiveWindow.Close
Range("C1").Select
Range("A1").Select
Range("A8:A250").Select
selection.NumberFormat = "000"
Range("B8:B250").Select
selection.NumberFormat = "0000"
Columns("E:H").Select
selection.Delete Shift:=xlToLeft
Columns("D:D").EntireColumn.AutoFit
Range("G8:I250").Select
selection.Style = "Currency"
ActiveWindow.SmallScroll ToRight:=4
Columns("J:J").Select
selection.Delete Shift:=xlToLeft
ActiveWindow.LargeScroll ToRight:=-1
Rows("7:7").Select
selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll ToRight:=3
Range("H1:H4").Select
Range("H1:H2").Select
selection.Cut destination:=Range("G1:G2")
Range("G1:G4").Select
Range("G4").Activate
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveWindow.LargeScroll ToRight:=1
Range("Q1:R2").Select
selection.Cut destination:=Range("J1:K2")
Range("J1:K2").Select
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.SmallScroll ToRight:=1
selection.Cut destination:=Range("I1:J2")
Range("I1:J2").Select
Columns("J:J").EntireColumn.AutoFit
Range("J1:J2").Select
With selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
ActiveWindow.LargeScroll ToRight:=-1
Range("A6:C250").Select
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A6").Select
Range("A6:J250").Select
selection.Borders(xlDiagonalDown).LineStyle = xlNone
selection.Borders(xlDiagonalUp).LineStyle = xlNone
With selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Procedure permettant d'ouvrir un fichier en fichier texte
'Créer par : Amine Kafal, Bnc 2008
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub LireFichierTxt()
Dim Ligne As String, NoLigne As Long, NoCol As Integer
Dim Tableau, Chemin, NomFich
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;D:\temp\macros fab\transfert_fichiers.csv", destination:=Range("A3"))
.name = "transfert_fichiers"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub |
