Funkcja unikatowaNazwaArkusza korzysta podczas działania z innych nie-wbudowanych funkcji prezentowanych na tej stronie, które w związku z tym również muszą być umieszczone w kodzie projektu dla prawidłowego działania tej funkcji.
Nie uwzględnienie ich w kodzie spowoduje wygenerowanie błędu: Compile error: Sub or Function not defined.
Dodatkowe funkcje wykorzystywane w funkcji unikatowaNazwaArkusza zostały wymienione poniżej. Klikając w nazwę każdej z nich przeniesiesz się do podstrony zawierającej jej kod:
Dodając powyższe funkcje, zwróć uwagę czy nie były one już wcześniej wykorzystywane w Twoim kodzie. Obecność w jednym projekcie VBA dwóch funkcji publicznych o identycznych nazwach spowoduje wygenerowanie błędu kompilacji o treści: Compile error: Ambiguous name detected: nazwa_funkcji.
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
'**********************************************************************************************************
' Nazwa: unikatowaNazwaArkusza
' Autor: mielk | 2013-04-16
'
' Opis: Funkcja sprawdza czy w podanym pliku Excela znajduje się już arkusz o podanej
' nazwie. Jeżeli tak, do nazwy arkusza doczepiana jest liczba porządkowa w nawiasie
' i w takiej postaci jest ona zwracana jako wynik działania funkcji.
'
' Argumenty:
' plik Obiekt typu Workbook. Plik Excela, dla którego podana nazwa ma być sprawdzona pod
' kątem unikalności.
' nazwa String. Nazwa arkusza, która jest sprawdzana pod kątem unikalności w podanym pliku
' Excela.
'
' Zwraca:
' String Jeżeli w podanym pliku nie ma jeszcze arkusza o podanej nazwie, nazwa ta zwracana
' jest w oryginalnej postaci, chyba że nie jest to prawidłowa nazwa dla arkusza
' Excela (np. jest za długa lub zawiera niedozwolone znaki) - w takiej sytuacji
' zwracana jest nazwa przetworzona do postaci prawidłowej nazwy arkusza (dzięki
' wykorzystaniu funkcji poprawnaNazwaArkusza).
'
' Jeżeli w podanym pliku występuje już arkusz o podanej nazwie, zwracana jest ta
' nazwa z dopisanym numerem porządkowym (również po wcześniejszym dostosowaniu jej
' do wymagań, jakie są stawiane przed nazwami arkuszy). Jeżeli po dopisaniu liczby
' porządkowej, otrzymana nazwa przekroczy maksymalną dopuszczalną długość nazwy
' arkusza (31 znaków), obcięta zostaje odpowiednia część oryginalnej nazwy.
'
' Przykład:
' -----------------------------------------------------------------------------------
' Dla określonego pliku sprawdzana jest unikalność nazwy arkusza dane.
' * Jeżeli w pliku nie ma jeszcze arkusza o takiej nazwie, funkcja zwróci oryginalną
' wartość - dane.
' * Jeżeli w pliku jest już arkusz o takiej nazwie, zwrócona zostanie nazwa dane (1).
' * Jeżeli również taka nazwa występuje już w pliku, funkcja zwróci nazwę
' dane (2), itd.
'
'
' Wyjątki:
' NiedostepnyPlik Zwracany, kiedy niemożliwe jest odniesienie się do pliku Excela
' podanego jako argument wejściowy [plik] (np. został on zamknięty).
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-04-16 mielk Utworzenie funkcji.
'**********************************************************************************************************
Public Function unikatowaNazwaArkusza(plik As Excel.Workbook, nazwa As String) As String
Const NAZWA_METODY As String = "unikatowaNazwaArkusza"
'------------------------------------------------------------------------------------------------------
Const MAX_DLUGOSC As Integer = 31
'------------------------------------------------------------------------------------------------------
Dim arkusz As Excel.Worksheet
Dim strTempNazwa As String
Dim intIterator As Integer
Dim intLicznikZnakow As Integer
'------------------------------------------------------------------------------------------------------
'Sprawdź czy podana nazwa jest poprawną nazwą arkusza. Jeżeli nie, przetwórz ją do poprawnej --------|
'postaci, za pomocą funkcji poprawnaNazwaArkusza '|
strTempNazwa = poprawnaNazwaArkusza(nazwa) '|
unikatowaNazwaArkusza = strTempNazwa '|
'----------------------------------------------------------------------------------------------------|
'Sprawdź, czy plik, dla którego będziemy sprawdzać unikatowość podanej nazwy, nie jest zamknięty.----|
If Not czyPrawidlowyPlik(plik) Then GoTo NiedostepnyPlik '|
'----------------------------------------------------------------------------------------------------|
'Funkcja próbuje znaleźć w podanym pliku arkusz o danej nazwie. W przypadku błędu tej operacji ------|
'(a więc sytuacji, gdy w pliku nie ma jeszcze takiego )arkusza, wykonywanie kodu przenoszone '|
'jest do etykiety unikatowaNazwa, znajdującej się tuż przed wyjściem z funkcji, co w praktyce '|
'oznacza zakończenie jej działania i zwrócenie oryginalnej wartości bez dopisywania jakichkolwiek '|
'oznaczeń (ewentualnie przetworzonej do postaci prawidłowej nazwy arkusza, jeżeli podana nazwa '|
'wcześniej nie spełniała wymogów poprawności). '|
On Error GoTo UnikatowaNazwa '|
Set arkusz = plik.Worksheets(strTempNazwa) '|
On Error GoTo 0 '|
'----------------------------------------------------------------------------------------------------|
'Jeżeli w pliku znaleziony został arkusz o podanej nazwie, niezbędna jest jej modyfikacja -----------|
'poprzez dopisanie odpowiedniej liczby. '|
If Not arkusz Is Nothing Then '|
'|
'Powtarzaj tę operację tak długo, jak istnieje arkusz z podaną nazwą. -----------------------| '|
Do '| '|
intIterator = intIterator + 1 '| '|
unikatowaNazwaArkusza = strTempNazwa & " (" & intIterator & ")" '| '|
'| '|
'Funkcja sprawdza czy wygenerowana nazwa nie przekracza maksymalnej dopuszczalnej ---| '| '|
'długości (zdefiniowanej przez stałą MAX_DLUGOSC) i ewentualnie skraca tę nazwę '| '| '|
'poprzez obcięcie znaków z prawej części oryginalnej nazwy. '| '| '|
'(the maximum length is defined by constant MAX_DLUGOSC). '| '| '|
intLicznikZnakow = VBA.Len(unikatowaNazwaArkusza) '| '| '|
If intLicznikZnakow > MAX_DLUGOSC Then '| '| '|
unikatowaNazwaArkusza = VBA.Left$(strTempNazwa, _
VBA.Len(strTempNazwa) - intLicznikZnakow + MAX_DLUGOSC) & _
" (" & intIterator & ")" '| '| '|
End If '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
'| '|
'Funkcja ponownie sprawdza czy w danym pliku występuje arkusz o podanej nazwie, -----| '| '|
'z tym że nazwa ta, po dopisaniu do niej odpowiedniej liczby porządkowej, ma '| '| '|
'teraz inną postać. '| '| '|
'Jeżeli również arkusz o takiej, zmodyfikowanej nazwie znajduje się już w tym '| '| '|
'pliku, nazwa jest ponownie modyfikowana poprzez zastąpienie dopisanej do niej '| '| '|
'liczby kolejną liczbą całkowitą np. zamiast nazwy dane (1), testowana będzie '| '| '|
'nazwa dane (2). '| '| '|
'Procedura powtarzana jest tak długo, aż funkcja natrafi na unikatową nazwę. '| '| '|
On Error GoTo UnikatowaNazwa '| '| '|
Set arkusz = plik.Worksheets(unikatowaNazwaArkusza) '| '| '|
On Error GoTo 0 '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
Loop Until arkusz Is Nothing '| '|
'--------------------------------------------------------------------------------------------| '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'==========================================================================================================
PunktWyjscia:
Exit Function
'----------------------------------------------------------------------------------------------------------
NiedostepnyPlik:
'Obsługa błędu dla sytuacji, kiedy niemożliwe jest odniesienie się do podanego pliku [plik] (np. z
'powodu jego zamknięcia).
GoTo PunktWyjscia
'----------------------------------------------------------------------------------------------------------
UnikatowaNazwa:
'Aktualna wartość zmiennej [nazwa] jest unikatowa i może być zwrócona.
End Function