質問編集履歴

1

説明追加

2019/11/02 04:35

投稿

hachi3156
hachi3156

score16

test CHANGED
File without changes
test CHANGED
@@ -178,123 +178,281 @@
178
178
 
179
179
  End Sub
180
180
 
181
-
182
-
183
- Public Sub ReadDBData(ByVal TarObjToWRITE As String, ByRef ReadList() As Variant, ByRef WriteList() As Variant, ByVal strSQL As String)
184
-
185
-
186
-
187
- Dim CntRow As Long
188
-
189
- Dim readobj As Object
190
-
191
- Dim writeobj As Object
181
+ ```
182
+
183
+
184
+
185
+ ###クラスモジュール3 returnObject
186
+
187
+
188
+
189
+ ```
190
+
191
+ ・クラス変数
192
+
193
+ Public Cls_ws As Worksheet
194
+
195
+ Public Cls_ADORes As ADODB.Recordset
196
+
197
+ Public Cls_Frm As UserForm
198
+
199
+
200
+
201
+ Public Function SetObjToRead(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
202
+
203
+ 'データを読み込む(コピーする)オブジェクトを選択
204
+
205
+ Select Case strTarObj
206
+
207
+
208
+
209
+ Case "CELL"
210
+
211
+
212
+
213
+ Set SetObjToRead = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)
214
+
215
+
216
+
217
+ Case "FIELD"
218
+
219
+
220
+
221
+ Set SetObjToRead = ObjField(Cls_strArrForSetObj(TarCol))
222
+
223
+
224
+
225
+ Case "CONTROL"
226
+
227
+
228
+
229
+ Set SetObjToRead = ObjControl(Cls_strArrForSetObj(TarCol))
230
+
231
+
232
+
233
+ End Select
234
+
235
+
236
+
237
+ End Function
238
+
239
+
240
+
241
+ Public Function SetObjToWrite(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
242
+
243
+ 'データを書き込む(ペーストする)オブジェクトを選択
244
+
245
+ Select Case strTarObj
246
+
247
+
248
+
249
+ Case "CELL"
250
+
251
+
252
+
253
+ Set SetObjToWrite = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)
254
+
255
+
256
+
257
+ Case "FIELD"
258
+
259
+
260
+
261
+ Set SetObjToWrite = ObjField(Cls_strArrForSetObj(TarCol))
262
+
263
+
264
+
265
+ Case "CONTROL"
266
+
267
+
268
+
269
+ Set SetObjToWrite = ObjControl(Cls_strArrForSetObj(TarCol))
270
+
271
+
272
+
273
+ End Select
274
+
275
+
276
+
277
+ End Function
278
+
279
+
280
+
281
+ Private Function ObjCell(ByRef Cls_strForSetObj As Variant, ByVal TarRow As Long) As Range
282
+
283
+
284
+
285
+ Set ObjCell = Cls_ws.Cells(TarRow, ColSlctByTitle(Cls_strForSetObj, Cls_ws))
286
+
287
+
288
+
289
+ End Function
290
+
291
+
292
+
293
+ ```
294
+
295
+
296
+
297
+
298
+
299
+ #修正
300
+
301
+ 追加の返信をいただく前に標準モジュールにしてしまいました。申し訳ないです。
302
+
303
+
304
+
305
+ 使用例:ワークシート→ユーザーフォーム間のデータのやりとり
306
+
307
+ ![イメージ説明](e6f1d9b8d456ff6e2fc80a3a80203e8a.png)
308
+
309
+
310
+
311
+ アクティブシートのデータを取得したい行を「行番号」のテキストボックスに入力してから、「コピー元決定」ボタンを押すとcmdC_DecideParts_Clickが動きます
312
+
313
+ データのやりとりを行うオブジェクトはSetObjToRead関数とSetObjToWrite関数で決めており、どのオブジェクトのどの要素をやりとりの対象とするのかを文字列として渡すことで目的のオブジェクトを決めています。
314
+
315
+ (例:データを読み込みたい(値をコピーしたい)オブジェクトをアクティブシートの7行目にある品番列のRangeオブジェクトにする場合)
316
+
317
+ →strTarObjName="CELL"、TarRowForCell=7,strTarElement="品番",TarObj=ActivesheetをSetObjToRead関数に引数として渡す
318
+
319
+ セルをデータのやり取りの対象にしたい場合は単純に列番号を渡すと列の順番を変更できないので、さらにcolslctbytitle関数に列名を文字列として渡して、渡した文字列とシートの列名が一致したらそのときの列番号をcolslctbytitle関数の返り値としています
320
+
321
+
322
+
323
+ ReadArray(),WriteArray()ではSetObjToRead関数とSetObjToWrite関数に渡すための文字列を決めています
324
+
325
+
326
+
327
+ 現状はShtToFrm関数のように(データの読み込み先:Worksheet)To(データの書き込み先:UserForm)として関数の名前を付けていますが、6パターン文の関数(ShtToFrm,FrmToSht,ShtToAccessDB,AccessDBToSht,FrmToAccessDB,AccessDBToFrm)
328
+
329
+ (データの書き込み先がAccessDBの場合は新規追加と更新もあるので、さらに関数が増えそう)
330
+
331
+ を作るのではなく、2,3つの関数にまとめられたらと考えています。
332
+
333
+
334
+
335
+ ユーザーフォームのモジュール(FrmCopyContentsInfoOfParts)
336
+
337
+ ```ここに言語を入力
338
+
339
+ Private Sub cmdC_DecideParts_Click()
340
+
341
+
342
+
343
+ Dim TarRow As Integer
344
+
345
+ TarRow = Me.txtRowNum.Value
346
+
347
+
348
+
349
+ Dim ReadArray() As Variant
350
+
351
+ Dim WriteArray() As Variant
352
+
353
+
354
+
355
+ '配列の要素はそれぞれ対応していなければならない(e.g:品番⇔txtC_PartNum)
356
+
357
+ ReadArray() = Array("品番", "図番", "図番改定", "品名", "型式名", "アキクラコード", "メーカー名", "メーカーコード", "仕入先", "仕入先コード", "標準原価単価", "標準発注単価", _
358
+
359
+ "ロット発注", "ロット単位数", "部品_在庫小数桁", "在庫用発注_棚卸変換値", "標準発注LT", "製番製品No_ロットNo", _
360
+
361
+ "部品単位", "発注単位", "品番分類", "在庫分類", "発注手配", "引当手配", "品番備考")
362
+
363
+ WriteArray() = Array("txtC_PartNum", "txtC_ChartNum", "txtC_ChartNumRev", "txtC_Item", "txtC_Model", "txtC_AkikuraCode", "txtC_maker", "txtC_MakerCode", "txtC_Vendor", "txtC_VendorCode", "txtC_Price", "txtC_OrderPrice", _
364
+
365
+ "txtC_Lot", "txtC_LotQty", "txtC_Digit", "txtC_ConversionValue", "txtC_LT", "txtC_LotNo", _
366
+
367
+ "txtC_PartsUnit", "txtC_OrderUnit", "txtC_PartNumClassCode", "txtC_StockClassCode", "txtC_OrderArrgtCode", "txtC_AllocArrgtCode", "txtC_Remark")
368
+
369
+ Call ShtToFrm(ReadArray(), WriteArray(), TarRow)
370
+
371
+
372
+
373
+ End Sub
374
+
375
+ ```
376
+
377
+
378
+
379
+ 以下、標準モジュール
380
+
381
+ ```ここに言語を入力
382
+
383
+ Public Sub ShtToFrm(ByRef strArrayToRead() As Variant, ByRef strArrayToWrite() As Variant, ByVal TarRow As Long)
384
+
385
+
386
+
387
+ If UBound(strArrayToRead) <> UBound(strArrayToWrite) Then
388
+
389
+
390
+
391
+ MsgBox "読み込み先の配列の要素数と書き込み先の配列の要素数が違います" & vbCrLf & "処理を中止します"
392
+
393
+ Exit Sub
394
+
395
+
396
+
397
+ End If
398
+
399
+
400
+
401
+ Dim StartRow As Long
192
402
 
193
403
  Dim LengthOfArray As Long
194
404
 
195
- Dim StartRow As Long
405
+
196
-
406
+
197
- Dim EndRow As Long
407
+ Dim ReadObj As Object
198
-
199
-
200
-
201
- Dim ADOCon As ADODB.Connection
408
+
202
-
203
- Dim ADORes As ADODB.Recordset
204
-
205
-
206
-
207
- Set ADOCon = initDb(ADODB_NAME, ADODB_PASS)
208
-
209
- Set ADORes = New ADODB.Recordset
210
-
211
-
212
-
213
- ADORes.Open strSQL, ADOCon
214
-
215
-
216
-
217
- Dim reObj As returnObject
409
+ Dim WriteObj As Object
218
-
219
- Set reObj = New returnObject
410
+
220
-
221
-
222
-
223
- '----標準モジュール記載
411
+
224
-
225
- Set reObj.Cls_ADORes = Createobject("ADODB.recordset")
412
+
226
-
227
- Set reObj.Cls_Frm = UserForm1
228
-
229
- '----
230
-
231
-
232
-
233
- StartRow = 3
234
-
235
- EndRow = 10
236
-
237
-
238
-
239
- For CntRow = StartRow To EndRow
240
-
241
- 'リストの要素数
242
-
243
- For LengthOfArray = LBound(ReadList) To UBound(ReadList)
413
+ For LengthOfArray = LBound(strArrayToRead) To UBound(strArrayToRead)
244
-
245
-
246
-
414
+
415
+
416
+
247
- Set readobj = reObj.SetObjToRead("FIELD", ReadList(), LengthOfArray, CntRow)
417
+ Set ReadObj = SetObjToRead("CELL", ActiveSheet, strArrayToRead(LengthOfArray), TarRow)
248
-
418
+
249
- Set writeobj = reObj.SetObjToWrite(TarObjToWRITE, WriteList(), LengthOfArray, CntRow)
419
+ Set WriteObj = SetObjToWrite("CONTROL", FrmCopyContentsInfoOfParts, strArrayToWrite(LengthOfArray))
250
-
251
-
252
-
420
+
421
+
422
+
253
- writeobj.Value = readobj.Value
423
+ WriteObj.Value = ReadObj.Value
254
-
255
-
256
-
424
+
425
+
426
+
257
- Next LengthOfArray
427
+ Next LengthOfArray
258
-
259
-
260
-
261
- Next CntRow
262
428
 
263
429
 
264
430
 
265
431
  End Sub
266
432
 
267
-
268
-
269
- ```
433
+ ```
434
+
270
-
435
+ 前回ではSetObjToReadやSetObjToWriteに配列を渡していたので、それを配列内の文字列を直接渡すようにしたのですが、こうしてみるとShtToFrmにも配列で渡す必要なかったですね
271
-
272
-
436
+
273
- ###クラスモジュル3 returnObject
437
+ そうすれば、forルプを関数の外で処理できそうです
274
-
275
-
276
-
438
+
277
- ```
439
+ ```ここに言語を入力
278
-
279
-
280
-
281
-
282
-
283
- ・クラス変数
440
+
284
-
285
- Public Cls_ws As Worksheet
441
+ Option Explicit
286
-
287
- Public Cls_ADORes As ADODB.Recordset
442
+
288
-
289
- Public Cls_Frm As UserForm
443
+
290
-
291
-
292
-
444
+
293
- Public Function SetObjToRead(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
445
+ Public Function SetObjToRead(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
294
446
 
295
447
  'データを読み込む(コピーする)オブジェクトを選択
296
448
 
449
+
450
+
451
+ On Error GoTo Err
452
+
453
+
454
+
297
- Select Case strTarObj
455
+ Select Case strTarObjName
298
456
 
299
457
 
300
458
 
@@ -302,39 +460,55 @@
302
460
 
303
461
 
304
462
 
305
- Set SetObjToRead = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)
463
+ Set SetObjToRead = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
306
-
307
-
464
+
465
+
308
466
 
309
467
  Case "FIELD"
310
468
 
311
-
312
-
469
+
470
+
313
- Set SetObjToRead = ObjField(Cls_strArrForSetObj(TarCol))
471
+ Set SetObjToRead = TarObj.Fields(strTarElement)
314
-
315
-
472
+
473
+
316
474
 
317
475
  Case "CONTROL"
318
476
 
319
-
320
-
477
+
478
+
321
- Set SetObjToRead = ObjControl(Cls_strArrForSetObj(TarCol))
479
+ Set SetObjToRead = TarObj.Controls(strTarElement)
322
-
323
-
480
+
481
+
324
482
 
325
483
  End Select
326
484
 
485
+
486
+
327
-
487
+ Exit Function
488
+
489
+
490
+
491
+ Err:
492
+
493
+ Call ErrHndl(Err.Number, Err.Description)
494
+
495
+
328
496
 
329
497
  End Function
330
498
 
331
499
 
332
500
 
333
- Public Function SetObjToWrite(ByVal strTarObj As String, ByRef Cls_strArrForSetObj() As Variant, ByVal TarCol As Long, Optional TarRowForCell As Long = 1) As Object
501
+ Public Function SetObjToWrite(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
334
502
 
335
503
  'データを書き込む(ペーストする)オブジェクトを選択
336
504
 
505
+
506
+
507
+ On Error GoTo Err
508
+
509
+
510
+
337
- Select Case strTarObj
511
+ Select Case strTarObjName
338
512
 
339
513
 
340
514
 
@@ -342,152 +516,124 @@
342
516
 
343
517
 
344
518
 
345
- Set SetObjToWrite = ObjCell(Cls_strArrForSetObj(TarCol), TarRowForCell)
519
+ Set SetObjToWrite = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
346
-
347
-
520
+
521
+
348
522
 
349
523
  Case "FIELD"
350
524
 
351
-
352
-
525
+
526
+
353
- Set SetObjToWrite = ObjField(Cls_strArrForSetObj(TarCol))
527
+ Set SetObjToWrite = TarObj.Fields(strTarElement)
354
-
355
-
528
+
529
+
356
530
 
357
531
  Case "CONTROL"
358
532
 
359
-
360
-
533
+
534
+
361
- Set SetObjToWrite = ObjControl(Cls_strArrForSetObj(TarCol))
535
+ Set SetObjToWrite = TarObj.Controls(strTarElement)
362
-
363
-
536
+
537
+
364
538
 
365
539
  End Select
366
540
 
541
+
542
+
367
-
543
+ Exit Function
544
+
545
+
546
+
547
+ Err:
548
+
549
+ Call ErrHndl(Err.Number, Err.Description)
550
+
551
+
368
552
 
369
553
  End Function
370
554
 
371
555
 
372
556
 
373
- Private Function ObjCell(ByRef Cls_strForSetObj As Variant, ByVal TarRow As Long) As Range
557
+ Private Sub ErrHndl(ByVal ErrNum As Long, ByVal ErrDiscription As Variant)
558
+
559
+
560
+
374
-
561
+ Select Case ErrNum
562
+
563
+
564
+
375
-
565
+ Case Else
566
+
567
+
568
+
376
-
569
+ MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラーの種類:" & ErrDiscription
570
+
571
+
572
+
573
+ End Select
574
+
575
+
576
+
577
+ End Sub
578
+
579
+
580
+
581
+ ```
582
+
583
+
584
+
585
+ ```ここに言語を入力
586
+
587
+ Public Const StartRow = 5
588
+
589
+
590
+
591
+ Public Function ColSlctByTitle(ByVal Title As String, ByVal ws As Worksheet, Optional ByVal DefaultRow As Integer = StartRow) As Integer
592
+
593
+
594
+
595
+ Dim CountCol As Integer
596
+
597
+ Dim titleRow As Integer
598
+
599
+ Dim MaxCol As Integer
600
+
601
+
602
+
603
+ titleRow = DefaultRow ' タイトル行番号
604
+
605
+
606
+
607
+ With ws
608
+
377
- Set ObjCell = Cls_ws.Cells(TarRow, ColSlctByTitle(Cls_strForSetObj, Cls_ws))
609
+ MaxCol = .Cells(DefaultRow, .Columns.Count).End(xlToLeft).Column
610
+
378
-
611
+ For CountCol = 1 To MaxCol
612
+
379
-
613
+ If .Cells(titleRow, CountCol).Text() = Title Then
614
+
615
+ ColSlctByTitle = CountCol
616
+
617
+ Exit Function ' 正常終了
618
+
619
+ End If
620
+
621
+ Next
622
+
623
+ End With
624
+
625
+
626
+
627
+ 'エラー終了
628
+
629
+ Err.Description = ws.Name & "のタイトル行に指定文字列( " + Title + " ) が見つかりませんでした"
630
+
631
+ Err.Raise (60000)
632
+
633
+ MsgBox (Err.Description)
634
+
635
+
380
636
 
381
637
  End Function
382
638
 
383
-
384
-
385
- ```
639
+ ```
386
-
387
-
388
-
389
- ###標準モジュール
390
-
391
- ```
392
-
393
- Public Function ColSlctByTitle(ByVal Title As String, ByVal ws As Worksheet, Optional ByVal DefaultRow As Integer = StartRow) As Integer
394
-
395
-
396
-
397
- Dim CountCol As Integer
398
-
399
- Dim titleRow As Integer
400
-
401
- Dim MaxCol As Integer
402
-
403
-
404
-
405
- titleRow = DefaultRow ' タイトル行番号
406
-
407
-
408
-
409
- With ws
410
-
411
- MaxCol = .Cells(DefaultRow, .Columns.Count).End(xlToLeft).Column
412
-
413
- For CountCol = 1 To MaxCol
414
-
415
- If .Cells(titleRow, CountCol).Text() = Title Then
416
-
417
- ColSlctByTitle = CountCol
418
-
419
- Exit Function ' 正常終了
420
-
421
- End If
422
-
423
- Next
424
-
425
- End With
426
-
427
-
428
-
429
- 'エラー終了
430
-
431
- Err.Description = ws.Name & "のタイトル行に指定文字列( " + Title + " ) が見つかりませんでした"
432
-
433
- Err.Raise (60000)
434
-
435
- MsgBox (Err.Description)
436
-
437
-
438
-
439
- End Function
440
-
441
-
442
-
443
- Public Function initDb(ByVal FileName As String, ByVal FilePass As String) As ADODB.Connection
444
-
445
-
446
-
447
- Dim ConnectionString As String '接続文字列
448
-
449
- Dim DbFilePass As String 'データベースファイルのパス
450
-
451
- Dim DbFileName As String 'データベースファイルの名前
452
-
453
-
454
-
455
- Dim ADOCon As ADODB.Connection 'データベース接続オブジェクト
456
-
457
- Dim strCon As String
458
-
459
-
460
-
461
- '接続文字列作成
462
-
463
- ConnectionString = "Microsoft.ACE.OLEDB.12.0"
464
-
465
- DbFileName = FileName & ".accdb"
466
-
467
-
468
-
469
- Set ADOCon = New ADODB.Connection
470
-
471
-
472
-
473
- ' 接続文字列を作成する
474
-
475
- strCon = "Provider=" & ConnectionString & ";" & "Data Source=" & FilePass & DbFileName & ";"
476
-
477
-
478
-
479
- '接続する
480
-
481
- ADOCon.Open strCon
482
-
483
-
484
-
485
- Set initDb = ADOCon
486
-
487
-
488
-
489
- End Function
490
-
491
-
492
-
493
- ```