-
Notifications
You must be signed in to change notification settings - Fork 0
/
macro
180 lines (146 loc) · 6.61 KB
/
macro
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
Sub ShowUserForm()
UserForm1.Show
End Sub
Sub OpenWebsiteAndImport()
Dim importFilePath As String
Dim importWb As Workbook
Dim localWs As Worksheet
Dim importWs As Worksheet
Dim existingSheet As Worksheet
Dim websiteURL As String
Dim wsName As String
Dim sheetExists As Boolean
Dim sheetCopied As Boolean
Dim lastRow As Long
' Define the URL of the page to open in Edge
websiteURL = "https://www.swimrankings.net/index.php?page=rankingDetail&clubId=273&gender=1&season=2024&course=LCM&agegroup=12012&stroke=10"
' Open the website in Edge
Shell "cmd /c start msedge.exe """ & websiteURL & """", vbNormalFocus
' Inform the user to interact with the webpage and generate the XLS file
MsgBox "Open de website in Edge, selecteer de benodigde informatie, genereer en sla het XLS-bestand op. Klik op OK wanneer u klaar bent om het bestand te importeren.", vbInformation
' Ask the user to select the Excel file to import
importFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Select the XLS/XLSX file to import")
' Check if the user canceled the file selection
If importFilePath = "False" Then
MsgBox "Geen bestand geselecteerd. Opdracht afgebroken.", vbExclamation
Exit Sub
End If
' Open the selected Excel file
On Error GoTo ErrorHandler
Set importWb = Workbooks.Open(importFilePath)
' Loop through each sheet in the imported workbook
For Each importWs In importWb.Sheets
wsName = importWs.Name
sheetExists = False
sheetCopied = False
' Check if the sheet with the same name exists in the local workbook
On Error Resume Next
Set existingSheet = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If Not existingSheet Is Nothing Then
' If the sheet exists, clear its contents and replace with new data
existingSheet.Cells.Clear
importWs.Cells.Copy Destination:=existingSheet.Cells
sheetExists = True
End If
If Not sheetExists Then
' If the sheet does not exist, copy it to the local workbook
importWs.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
sheetCopied = True
End If
Next importWs
' Close the imported workbook without saving
importWb.Close False
' Optional: Autofit columns in each sheet
For Each localWs In ThisWorkbook.Sheets
localWs.Columns.AutoFit
Next localWs
' Display completion message
MsgBox "Alle werkbladen zijn geïmporteerd en bijgewerkt.", vbInformation
' Add the unique ID column to each imported sheet, except "NJK Analyse"
For Each localWs In ThisWorkbook.Sheets
If localWs.Name <> "NJK Analyse" Then
lastRow = localWs.Cells(localWs.Rows.Count, "F").End(xlUp).Row ' Assuming fullname is in column F and birthday is in column G
' Insert a new column at A
localWs.Columns("A:A").Insert Shift:=xlToRight
' Set the header for the new column
localWs.Range("A1").Value = "uniqueID"
' Combine fullname (F) and birthday (G) to create uniqueID
localWs.Range("A2:A" & lastRow).Formula = "=F2 & ""_"" & G2"
End If
Next localWs
' Display completion message for adding unique IDs
MsgBox "Unieke ID-kolommen zijn toegevoegd aan de geïmporteerde werkbladen, met uitzondering van 'NJK Analyse'.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Fout bij het openen van het geselecteerde Excel-bestand. Controleer het bestand en probeer het opnieuw.", vbCritical
Exit Sub
End Sub
Sub ImportFileOnly()
Dim importFilePath As String
Dim importWb As Workbook
Dim localWs As Worksheet
Dim importWs As Worksheet
Dim existingSheet As Worksheet
Dim wsName As String
Dim sheetExists As Boolean
Dim sheetCopied As Boolean
Dim lastRow As Long
' Ask the user to select the Excel file to import
importFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Select the XLS/XLSX file to import")
' Check if the user canceled the file selection
If importFilePath = "False" Then
MsgBox "Geen bestand geselecteerd. Opdracht afgebroken.", vbExclamation
Exit Sub
End If
' Open the selected Excel file
On Error GoTo ErrorHandler
Set importWb = Workbooks.Open(importFilePath)
' Loop through each sheet in the imported workbook
For Each importWs In importWb.Sheets
wsName = importWs.Name
sheetExists = False
sheetCopied = False
' Check if the sheet with the same name exists in the local workbook
On Error Resume Next
Set existingSheet = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If Not existingSheet Is Nothing Then
' If the sheet exists, clear its contents and replace with new data
existingSheet.Cells.Clear
importWs.Cells.Copy Destination:=existingSheet.Cells
sheetExists = True
End If
If Not sheetExists Then
' If the sheet does not exist, copy it to the local workbook
importWs.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
sheetCopied = True
End If
Next importWs
' Close the imported workbook without saving
importWb.Close False
' Optional: Autofit columns in each sheet
For Each localWs In ThisWorkbook.Sheets
localWs.Columns.AutoFit
Next localWs
' Display completion message
MsgBox "Alle werkbladen zijn geïmporteerd en bijgewerkt.", vbInformation
' Add the unique ID column to each imported sheet, except "NJK Analyse"
For Each localWs In ThisWorkbook.Sheets
If localWs.Name <> "NJK Analyse" Then
lastRow = localWs.Cells(localWs.Rows.Count, "F").End(xlUp).Row ' Assuming fullname is in column F and birthday is in column G
' Insert a new column at A
localWs.Columns("A:A").Insert Shift:=xlToRight
' Set the header for the new column
localWs.Range("A1").Value = "uniqueID"
' Combine fullname (F) and birthday (G) to create uniqueID
localWs.Range("A2:A" & lastRow).Formula = "=F2 & ""_"" & G2"
End If
Next localWs
' Display completion message for adding unique IDs
MsgBox "Unieke ID-kolommen zijn toegevoegd aan de geïmporteerde werkbladen, met uitzondering van 'NJK Analyse'.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Fout bij het openen van het geselecteerde Excel-bestand. Controleer het bestand en probeer het opnieuw.", vbCritical
Exit Sub
End Sub