質問編集履歴

4

修正

2021/10/06 06:08

投稿

cc000072
cc000072

スコア28

test CHANGED
File without changes
test CHANGED
@@ -210,6 +210,46 @@
210
210
 
211
211
  Rs.Close
212
212
 
213
+
214
+
215
+ ERR_HANDLER:
216
+
217
+
218
+
219
+ 'エラーメッセージ
220
+
221
+ Debug.Print Err.Number & ")" & Err.Description
222
+
223
+ MsgBox Err.Number & ")" & Err.Description
224
+
225
+
226
+
227
+ '--------------------------------
228
+
229
+ ' データベース切断
230
+
231
+ '--------------------------------
232
+
233
+ If Not Rs Is Nothing Then
234
+
235
+ If Rs.State = adStateOpen Then Rs.Close
236
+
237
+ Set Rs = Nothing
238
+
239
+ End If
240
+
241
+ If Not cn Is Nothing Then
242
+
243
+ If cn.State = adStateOpen Then cn.Close
244
+
245
+ Set cn = Nothing
246
+
247
+ End If
248
+
249
+
250
+
251
+ End Sub
252
+
213
253
  ```
214
254
 
215
255
 

3

修正

2021/10/06 06:08

投稿

cc000072
cc000072

スコア28

test CHANGED
File without changes
test CHANGED
@@ -116,6 +116,100 @@
116
116
 
117
117
  Rs.Open strSQL, cn
118
118
 
119
+
120
+
121
+ '--------------------------------
122
+
123
+ ' カラム名を取得
124
+
125
+ '--------------------------------
126
+
127
+
128
+
129
+
130
+
131
+ For intNumberColumns = 0 To Rs.Fields.Count - 1
132
+
133
+
134
+
135
+ Worksheets("NAV Price").Cells(1, intNumberColumns + 1).Value = Rs.Fields(intNumberColumns).Name
136
+
137
+
138
+
139
+ Next intNumberColumns
140
+
141
+
142
+
143
+
144
+
145
+ '--------------------------------
146
+
147
+ ' 取得データをセルに一括出力
148
+
149
+ '--------------------------------
150
+
151
+ intNumberRows = 2
152
+
153
+
154
+
155
+ Do Until Rs.EOF
156
+
157
+
158
+
159
+ Cells(intNumberRows, 1).Value = Rs.Fields("ID").Value
160
+
161
+ Cells(intNumberRows, 2).Value = Rs.Fields("EMPNAME").Value
162
+
163
+
164
+
165
+ intNumberRows = intNumberRows + 1
166
+
167
+ Rs.MoveNext
168
+
169
+
170
+
171
+ Loop
172
+
173
+
174
+
175
+ ' Set objCol = Rs.Fields
176
+
177
+ ' ingColSu = objCol.Count
178
+
179
+
180
+
181
+
182
+
183
+ '--------------------------------
184
+
185
+ ' データベース切断
186
+
187
+ '--------------------------------
188
+
189
+
190
+
191
+ If Not Rs Is Nothing Then
192
+
193
+ If Rs.State = adStateOpen Then Rs.Close
194
+
195
+ Set Rs = Nothing
196
+
197
+ End If
198
+
199
+ If Not cn Is Nothing Then
200
+
201
+ If cn.State = adStateOpen Then cn.Close
202
+
203
+ Set cn = Nothing
204
+
205
+ End If
206
+
207
+
208
+
209
+ cn.Close
210
+
211
+ Rs.Close
212
+
119
213
  ```
120
214
 
121
215
 

2

追加

2021/10/06 04:32

投稿

cc000072
cc000072

スコア28

test CHANGED
File without changes
test CHANGED
@@ -21,6 +21,8 @@
21
21
 
22
22
 
23
23
  ```Macro
24
+
25
+ 標準モジュール
24
26
 
25
27
  Sub Load_NAV_Data()
26
28
 
@@ -120,6 +122,8 @@
120
122
 
121
123
  ```Macro
122
124
 
125
+ 入力フォーム
126
+
123
127
  Public StandardDate As String
124
128
 
125
129
 

1

ロジック追加

2021/10/06 00:48

投稿

cc000072
cc000072

スコア28

test CHANGED
File without changes
test CHANGED
@@ -22,25 +22,119 @@
22
22
 
23
23
  ```Macro
24
24
 
25
- StandardDateForm.Show
25
+ Sub Load_NAV_Data()
26
-
27
- strStandardDate = StandardDateForm.StandardDate
28
26
 
29
27
 
30
28
 
29
+ On Error GoTo ERR_HANDLER
30
+
31
+ Dim strSQL As String
32
+
31
- Unload StandardDateForm
33
+ Dim strStandardDate As String
34
+
35
+ Dim intNumberColumns As Long
36
+
37
+ Dim intNumberRows As Long
32
38
 
33
39
 
34
40
 
35
- If strStandardDate = StrConv(strStandardDate, vbWide) Then
41
+ Dim objCol As Object
42
+
43
+ Dim ingColSu As Long
44
+
45
+ Dim iCols As Long
36
46
 
37
47
 
38
48
 
49
+
50
+
39
- strStandardDate = StrConv(strStandardDate, vbNarrow)
51
+ '--------------------------------
52
+
53
+ ' データベース接続
54
+
55
+ '--------------------------------
40
56
 
41
57
 
42
58
 
59
+
60
+
61
+ '--------------------------------
62
+
63
+ ' 基準価額の基準日を取得
64
+
65
+ '--------------------------------
66
+
67
+ StandardDateForm.Show
68
+
69
+ strStandardDate = StandardDateForm.StandardDate
70
+
71
+ Unload StandardDateForm
72
+
73
+
74
+
75
+ If strStandardDate = StrConv(strStandardDate, vbWide) Then
76
+
77
+
78
+
79
+ strStandardDate = StrConv(strStandardDate, vbNarrow)
80
+
81
+
82
+
43
- End If
83
+ End If
84
+
85
+
86
+
87
+ MsgBox strStandardDate
88
+
89
+
90
+
91
+ '--------------------------------
92
+
93
+ ' SQLの実行
94
+
95
+ '--------------------------------
96
+
97
+ Dim Rs As New ADODB.Recordset
98
+
99
+ Set Rs = New ADODB.Recordset
100
+
101
+ Rs.CursorLocation = adUseClient
102
+
103
+
104
+
105
+ strSQL = "SELECT HR.ID,"
106
+
107
+ strSQL = strSQL & "HR.EMPNAME "
108
+
109
+ strSQL = strSQL & "FROM HR "
110
+
111
+ strSQL = strSQL & "WHERE (HR.基準日_文字型='" & strStandardDate & "') AND (HR.WORKINGYEAR>$0)"
112
+
113
+
114
+
115
+ Rs.Open strSQL, cn
116
+
117
+ ```
118
+
119
+
120
+
121
+ ```Macro
122
+
123
+ Public StandardDate As String
124
+
125
+
126
+
127
+ Private Sub OKButton_Click()
128
+
129
+
130
+
131
+ StandardDate = Me.StandardDateInputBox
132
+
133
+ Me.Hide
134
+
135
+
136
+
137
+ End Sub
44
138
 
45
139
  ```
46
140