Funkcja printujDoPlikuTekstowego 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 printujDoPlikuTekstowego 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
'**********************************************************************************************************
' Nazwa: printujDoPlikuTekstowego
' Autor: mielk | 2012-12-06
'
' Opis: Funkcja printująca podaną zawartość (tekst lub tablicę) do podanego
' pliku tekstowego.
'
' Argumenty:
' tresc Treść, która ma zostać wyprintowana w podanym pliku tekstowym.
' sciezkaDoPliku Ścieżka do pliku, w którym ma zostać wyprintowana podana treść.
' czyNadpisywac Argument opcjonalny.
' Określa czy podana zawartość ma zostać dopisana do dotychczasowej zawartości
' wskazanego pliku tekstowego czy też ma nadpisać tę zawartość.
'
' Zwraca:
' Boolean True - jeżeli podana zawartość została pomyślnie wyprintowana do wskazanego pliku
' tekstowego.
' False - jeżeli wystąpił któryś z opisanych poniżej wyjątków i podana zawartość nie
' mogła zostać wyprintowana.
'
'
' Wyjątki:
' NiedozwolonyObiekt Zwracany, kiedy zmienna [tresc] jest obiektem.
'
' NiedozwolonaLiczbaWymiarow Zwracany, kiedy zmienna [tresc] jest tablicą posiadającą więcej niż
' dwa wymiary.
'
' BrakDostepuDoPliku Zwracany, kiedy użytkownik nie może zapisywać pod podaną ścieżką (np.
' nie ma prawa do zapisu lub podana ścieżka nie istnieje).
'
' NiemozliweStworzenieFolderu Zwracany, kiedy nie jest możliwe stworzenie folderu nadrzędnego,
' w którym miałby się znaleźć docelowy plik.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-12-06 mielk Utworzenie funkcji.
'**********************************************************************************************************
Public Function printujDoPlikuTekstowego(tresc As Variant, sciezkaDoPliku As String, _
Optional czyNadpisywac As Boolean = False) As Boolean
Const NAZWA_METODY As String = "printujDoPlikuTekstowego"
'------------------------------------------------------------------------------------------------------
'Obiekty nie mogą być printowane, ponieważ nie posiadają reprezentacji tekstowej, dlatego zwracany
'jest wyjątek NiedozwolonyObiekt.
If VBA.IsObject(tresc) Then GoTo NiedozwolonyObiekt
'Funkcja sprawdza czy podana ścieżka jest dostępna i aktualny użytkownik ma uprawnienia,
'aby do niej zapisywać.
If Not czyMozliwyZapisDoPlikuTekstowego(sciezkaDoPliku) Then GoTo BrakDostepuDoPliku
'Funkcja tworzy folder nadrzędny dla wskazanej ścieżki do pliku, o ile nie był on jeszcze stworzony.
'Jeśli nie jest możliwe stworzenie folderu, kod jest przenoszony do labelu NiemozliweStworzenieFolderu.
If utworzFolder(getParentFolder(sciezkaDoPliku)) Is Nothing Then GoTo NiemozliweStworzenieFolderu
'Jeżeli argument czyNadpisac jest ustawiony na True, procedura kasuje dotychczasowy plik (o ile
'taki istnieje). Podczas zapisu, w dalszej części procedury, zostanie on utworzony na nowo.
If czyNadpisywac Then Call usunPlik(sciezkaDoPliku)
'Funkcja wywołuje oddzielne podprocedury dla tablic i zmiennych prostych, dlatego sprawdza ----------|
'czy funkcja jest tablicą. '|
If VBA.IsArray(tresc) Then '|
'|
'Procedury printowania różnią się dla tablic jedno- i dwuwymiarowych, dlatego ---------------| '|
'zastosowana jest konstrukcja Select Case, która sprawdza ile wymiarów posiada tablica, '| '|
'a następnie wywołuje odpowiednią podprocedurę. '| '|
Select Case liczWymiary(tresc) '| '|
Case 1: Call printujDoPlikuTekstowego_Tablica1D(tresc, sciezkaDoPliku) '| '|
Case 2: Call printujDoPlikuTekstowego_Tablica2D(tresc, sciezkaDoPliku) '| '|
Case Else '| '|
'Tablic posiadających więcej wymiarów nie da się printować, dlatego '| '|
'wywoływany jest wyjątek NiedozwolonaLiczbaWymiarow. '| '|
GoTo NiedozwolonaLiczbaWymiarow '| '|
End Select '| '|
'--------------------------------------------------------------------------------------------| '|
'|
Else '|
'|
'Jeżeli zmienna zawartosc nie jest tablicą ani obiektem, może być ona już tylko zmienną '|
'typu prostego. W takiej sytuacji wywoływana jest podprocedura doPlikuTekstowego_TypProsty. '|
Call doPlikuTekstowego_TypProsty(tresc, sciezkaDoPliku) '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'Jeżeli wykonywanie kodu dotarło do tego miejsca, oznacza to, że podana zawartość została pomyślnie
'wyprintowana do pliku tekstowego i funkcja zwraca wartość True.
printujDoPlikuTekstowego = True
'==========================================================================================================
PunktWyjscia:
Exit Function
'----------------------------------------------------------------------------------------------------------
NiedozwolonyObiekt:
'(...)
'Obsługa błędów dla przypadku, jeśli parametr podany do funkcji jest obiektem i nie można zamienić go
'na typ tekstowy.
GoTo PunktWyjscia
NiedozwolonaLiczbaWymiarow:
'(...)
'Obsługa błędów dla przypadku, kiedy parametr wejściowy [tresc] jest tablicą, ale posiada więcej
'niż dwa wymiary.
GoTo PunktWyjscia
BrakDostepuDoPliku:
'(...)
'Obsługa błędów dla przypadku, kiedy użytkownik nie ma prawa zapisu pod podaną ścieżką lub podana
'ścieżka nie istnieje.
GoTo PunktWyjscia
NiemozliweStworzenieFolderu:
'(...)
'Obsługa błędów dla przypadku, kiedy niemożliwe jest stworzenie folderu nadrzędnego, w którym miałby
'się znaleźć plik z podaną ścieżką.
GoTo PunktWyjscia
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'**********************************************************************************************************
' Nazwa: printujDoPlikuTekstowego_TypProsty
'
' Opis: Podfunkcja printująca wartości prymitywne do podanego pliku tekstowego.
'**********************************************************************************************************
Private Sub doPlikuTekstowego_TypProsty(tresc As Variant, sciezkaPliku As String)
Const NAZWA_METODY As String = "doPlikuTekstowego_TypProsty"
'------------------------------------------------------------------------------------------------------
Dim intNumerPliku As Integer
'------------------------------------------------------------------------------------------------------
intNumerPliku = VBA.FreeFile()
Open sciezkaPliku For Append As #intNumerPliku
Print #intNumerPliku, tresc
Close intNumerPliku
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'**********************************************************************************************************
' Nazwa: printujDoPlikuTekstowego_Tablica1D
'
' Opis: Podprocedura printująca dla tablic jednowymiarowych.
'**********************************************************************************************************
Private Sub printujDoPlikuTekstowego_Tablica1D(tresc As Variant, sciezkaDoPliku As String)
Const NAZWA_METODY As String = "printujDoPlikuTekstowego_Tablica1D"
'------------------------------------------------------------------------------------------------------
Dim iNumerPliku As Integer
Dim lngWiersz As Long
'------------------------------------------------------------------------------------------------------
iNumerPliku = VBA.FreeFile()
Open sciezkaDoPliku For Append As #iNumerPliku
For lngWiersz = LBound(tresc, 1) To UBound(tresc, 1)
Print #iNumerPliku, tresc(lngWiersz)
Next lngWiersz
Close iNumerPliku
End Sub
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
'**********************************************************************************************************
' Nazwa: printujDoPlikuTekstowego_Tablica2D
'
' Opis: Podprocedura printująca dla tablic dwuwymiarowych.
'**********************************************************************************************************
Private Sub printujDoPlikuTekstowego_Tablica2D(tresc As Variant, sciezkaDoPliku As String)
Const NAZWA_METODY As String = "printujDoPlikuTekstowego_Tablica2D"
'Stała definiująca separator, który będzie użyty do oddzielenia od siebie wartości w poszczególnych
'kolumnach printowanej tablicy.
Const SEPARATOR As String = ";"
'------------------------------------------------------------------------------------------------------
Dim iNumerPliku As Integer
Dim lngWiersz As Long
Dim lngKolumna As Long
Dim strKolumna As String
'------------------------------------------------------------------------------------------------------
iNumerPliku = VBA.FreeFile()
Open sciezkaDoPliku For Append As #iNumerPliku
For lngWiersz = LBound(tresc, 1) To UBound(tresc, 1)
'Przed przetworzeniem każdego kolejnego wiersza źródłowej tablicy zawartość tymczasowej zmiennej
'strKolumna jest czyszczona, aby nie zawierała danych z poprzednich wierszy.
strKolumna = ""
'Pętla dołącza do tymczasowej zmiennej [strKolumna] wartości wszystkich komórek leżących w danym
'wierszu tablicy źródłowej, oddzielając je od siebie znakiem lub ciągiem znaków określonym przez
'stałą [SEPARATOR].
For lngKolumna = LBound(tresc, 2) To UBound(tresc, 2)
strKolumna = strKolumna & tresc(lngWiersz, lngKolumna) & SEPARATOR
Next lngKolumna
'Separator dodany po wartości z ostatniej kolumny jest usuwany.
If VBA.Len(strKolumna) Then
strKolumna = VBA.Left$(strKolumna, VBA.Len(strKolumna) - 1)
End If
'Wreszcie tak przetworzony tekst jest printowany w pliku tekstowym.
Print #iNumerPliku, strKolumna
Next lngWiersz
Close iNumerPliku
End Sub