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
|
Option Explicit
Const Pass As String = "0179"
Sub Example()
'Variables
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook, xlsheet As Worksheet
Dim CalcMode As Long, ErrorYes As Boolean
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Dim ActiveWorksheet As Worksheet
Set xlsheet = ThisWorkbook.Worksheets("Paramètres")
'Fill in the path\folder where the files are
MyPath = "C:\Documents and Settings\apoirierrouillard\Bureau\TestVBA\Test2VBA"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
'Change cell value(s) in one worksheet in
With ThisWorkbook.Worksheets(1)
If .ProtectContents = True Then .Unprotect Password:=Pass
End With
With mybook.Worksheets(1)
If .ProtectContents = True Then .Unprotect Password:=Pass
End With
With mybook.Worksheets(1)
.Shapes("Zone_d_impression").Delete
End With
With mybook.Worksheets(1)
ThisWorkbook.Worksheets(1).Range("G17:L36").Copy .Range("G17:L36")
.Protect Password:=Pass
End With
'Save and close mybook
mybook.Close savechanges:=True
Next Fnum
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub |
