-
Notifications
You must be signed in to change notification settings - Fork 1
/
Arkusz5.cls
212 lines (176 loc) · 5.79 KB
/
Arkusz5.cls
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
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Arkusz5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Base 1 'tablice sa numerowane od 1
'Funkcja mieniająca kropki na przecinki
Function zamien_kropi(arg As String) As Double
arg = Replace(arg, ".", ",")
zamien_kropi = CDbl(arg) 'konwertuje dane do typu double
End Function
'Funkcja skaluj uklad
Private Sub CommandButton1_Click()
On Error GoTo Error_handler
Dim n As Integer
Dim m As Integer
Dim H As Integer
Dim x As String
Dim y As String
Dim z As String
Dim xz As String
Dim ilosc_wierszy_maly As Long
Dim ilosc_kolumn_maly As Integer
Dim maly_uklad As Variant 'Efektywne wczytywanie za pomoca zmiannej variant
'Wczytaj zmienne
n = TextBox1 'x
m = TextBox4 'y
H = TextBox7 'z
x = TextBox2
y = TextBox3
z = TextBox5
xz = TextBox6
x = zamien_kropi(x)
y = zamien_kropi(y)
z = zamien_kropi(z)
xz = zamien_kropi(xz)
'Wczytaj uklad
Const a As Integer = 3 'Komórki w których zaczyna się tabela
Const b As Integer = 1
Wczytywaj_uklad a, b, ilosc_wierszy_maly, ilosc_kolumn_maly, maly_uklad, x, y, z, xz
'procedura musi mieć
'zapisane wczystkie zmienne które wchodzą i wychodzą z niej
'Skaluj uklad
skalowanie H, n, m, x, y, z, xz, ilosc_wierszy_maly, ilosc_kolumn_maly, maly_uklad
'wywoływanie procedury i argumenty
MsgBox "Koniec"
Exit Sub 'Kończy procedurę
Error_handler:
MsgBox "Złe typy wprowadzanych danny, id atomu nie może równac sie 0" 'komunikat przy bledzie
Err.Clear 'czyści błędy
End Sub
'Funkcja twórz wiązania
Private Sub CommandButton2_Click()
'On Error GoTo Error_handler
Dim IdO As Variant
Dim IdH As Variant
Dim x As String
Dim y As String
Dim z As String
Dim xz As String
Dim R1 As String
Dim Wczytywanie_id_z_listy As Boolean
Dim ilosc_wierszy_maly As Long
Dim ilosc_kolumn_maly As Integer
Dim maly_uklad As Variant
Dim lista_ID As Variant
Dim wiersze_listy_ID As Integer
x = TextBox2
y = TextBox3
z = TextBox5
xz = TextBox6
R1 = TextBox8
Wczytywanie_id_z_listy = Range("J31")
If Wczytywanie_id_z_listy = True Then
MsgBox ("Wczytuję z listy")
i = 0
Do While Worksheets("Systam-skalowanie duzy").Cells(56 + i, 9) > 0
i = i + 1
Loop
If i = 0 Then
MsgBox (" Pusta lista")
Else
wiersze_listy_ID = i
lista_ID = Range(Cells(56, 9), Cells(55 + wiersze_listy_ID, 12))
End If
Else
IdH = TextBox10
IdO = TextBox11
IdH = CDbl(IdH)
IdO = CDbl(IdO)
End If
x = zamien_kropi(x)
y = zamien_kropi(y)
z = zamien_kropi(z)
xz = zamien_kropi(xz)
R1 = zamien_kropi(R1)
'Wczytaj uklad- Komórki w których zaczyna się tabela
Const a As Integer = 3 'stała, nie da się przypisać wartości do stałej
Const b As Integer = 13 'stała
'maly_uklad = układ wczytywany- obszar dużego układu.
Wczytywaj_uklad a, b, ilosc_wierszy_maly, ilosc_kolumn_maly, maly_uklad, x, y, z, xz
'Znajdź wiązania
Znajdowanie_wiazan x, y, z, xz, R1, IdH, IdO, maly_uklad, ilosc_wierszy_maly, lista_ID, wiersze_listy_ID
MsgBox "Koniec"
Exit Sub 'Kończy procedurę
'Error_handler:
'MsgBox "Złe typy wprowadzanych danny, id atomu nie może równac sie 0" 'komunikat przy bledzie
'Err.Clear 'czyści błędy
End Sub
'Funkcja twórz wiazania katowe
Private Sub CommandButton3_Click()
'On Error GoTo Error_handler 'gdy jest blad przekierowuje do Error_handler
Dim R1 As String
Dim R2 As String
Dim IdO As Variant
Dim IdH As Variant
Dim Idsub As Variant
Dim Wczytywanie_id_z_listy As Boolean
Dim x As String
Dim y As String
Dim z As String
Dim xz As String
Dim lista_ID As Variant
Dim wiersze_listy_ID As Integer
x = TextBox2
y = TextBox3
z = TextBox5
xz = TextBox6
R1 = TextBox8
R2 = TextBox9
Wczytywanie_id_z_listy = Range("J31")
If Wczytywanie_id_z_listy = True Then
MsgBox ("Wczytuję z listy")
i = 0
Do While Worksheets("Systam-skalowanie duzy").Cells(56 + i, 9) > 0
i = i + 1
Loop
If i = 0 Then
MsgBox (" Pusta lista")
Else
wiersze_listy_ID = i
lista_ID = Range(Cells(56, 9), Cells(55 + wiersze_listy_ID, 12))
End If
Else
IdH = TextBox10
IdO = TextBox11
Idsub = TextBox12
IdH = CDbl(IdH)
IdO = CDbl(IdO)
Idsub = CDbl(Idsub)
End If
x = zamien_kropi(x)
y = zamien_kropi(y)
z = zamien_kropi(z)
xz = zamien_kropi(xz)
R1 = zamien_kropi(R1)
R2 = zamien_kropi(R2)
'Wczytaj uklad- Komórki w których zaczyna się tabela
Const a As Integer = 3 'stała, nie da się przypisać wartości do stałej
Const b As Integer = 13 'stała
'maly_uklad = układ wczytywany- obszar dużego układu.
Wczytywaj_uklad a, b, ilosc_wierszy_maly, ilosc_kolumn_maly, maly_uklad, x, y, z, xz
'Znajdź wiązania wiazania katowe
katy_sub x, y, z, xz, R1, R2, IdH, IdO, Idsub, maly_uklad, ilosc_wierszy_maly, lista_ID, wiersze_listy_ID
MsgBox "Koniec"
Exit Sub 'Kończy procedurę
'Error_handler:
'MsgBox "Złe typy wprowadzanych danny, id atomu nie może równac sie 0" 'komunikat przy bledzie
'Err.Clear 'czyści błędy
End Sub
Private Sub Label7_Click()
End Sub