質問編集履歴

2

補足のところに追記

2024/04/10 06:35

投稿

tdpdjt1
tdpdjt1

スコア1

test CHANGED
File without changes
test CHANGED
@@ -263,4 +263,296 @@
263
263
  Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。
264
264
 
265
265
  ### 補足
266
+ Function 会場データインポート(WK_会場)
267
+
268
+
269
+
270
+
271
+
272
+ Dim XLAPP As Object
273
+
274
+ Dim varFLName As Variant
275
+
276
+ Dim FLName As String
277
+
278
+ Dim Rc1 As Recordset
279
+
280
+ Dim Rc2 As Recordset
281
+
282
+ Dim Rc3 As Recordset
283
+
284
+ Dim SQL As String
285
+
286
+ Dim MsgTitle As String
287
+
288
+ Dim FilePath As String
289
+
290
+ Dim WK_ROW As Integer
291
+
292
+ Dim ST_ROW As Integer
293
+
294
+ Dim WK_COL As Integer
295
+
296
+ Dim WK_COL2 As Integer
297
+
298
+ Dim Str_SQL As String
299
+
300
+ Dim Err_flg As Boolean
301
+
302
+ Dim 会場データ As String
303
+
304
+
305
+
306
+
307
+
308
+ 'エラーリスト作成
309
+
310
+ 'WK_会場マスター→T_会場へ
311
+
312
+
313
+
314
+ Set Rc1 = CurrentDb.OpenRecordset("T_会場")
315
+
316
+ Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")
317
+
318
+ Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")
319
+
320
+
321
+
322
+ If Rc2.RecordCount > 0 Then
323
+
324
+ Do Until Rc2.EOF = True
325
+
326
+ Err_flg = False
327
+
328
+
329
+
330
+ If Len(Trim(Rc2![受験地区])) > 5 Then
331
+
332
+ 会場データ = "Rc2[受験地区]"
333
+
334
+ Call エラーデータインポート(会場データ)
335
+
336
+ End If
337
+
338
+
339
+
340
+ If Len(Trim(Rc2![会場名])) > 30 Then
341
+
342
+ 会場データ = "Rc2[会場名]"
343
+
344
+ Call エラーデータインポート(会場データ)
345
+
346
+ End If
347
+
348
+
349
+
350
+ If Len(Trim(Rc2![会場名略])) > 20 Then
351
+
352
+ 会場データ = "Rc2[会場名略]"
353
+
354
+ Call エラーデータインポート(会場データ)
355
+
356
+ End If
357
+
358
+
359
+
360
+ If Len(Trim(Rc2![所在地])) > 30 Then
361
+
362
+ 会場データ = "Rc2[所在地]"
363
+
364
+ Call エラーデータインポート(会場データ)
365
+
366
+ End If
367
+
368
+
369
+
370
+ If Len(Trim(Rc2![交通手段1])) > 30 Then
371
+
372
+ 会場データ = "Rc2[交通手段1]"
373
+
374
+ Call エラーデータインポート(会場データ)
375
+
376
+ End If
377
+
378
+
379
+
380
+ If Len(Trim(Rc2![交通手段2])) > 30 Then
381
+
382
+ 会場データ = "Rc2[交通手段2]"
383
+
384
+ Call エラーデータインポート(会場データ)
385
+
386
+ End If
387
+
388
+
389
+
390
+ If Len(Trim(Rc2![交通手段3])) > 30 Then
391
+
392
+ 会場データ = "Rc2[交通手段3]"
393
+
394
+ Call エラーデータインポート(会場データ)
395
+
396
+ End If
397
+
398
+
399
+
400
+
401
+
402
+ ' If Err_flg = False Then
403
+
404
+ Rc1.AddNew
405
+
406
+ Rc1![会場コード] = Rc2![会場コード]
407
+
408
+ Rc1![受験地] = Rc2![受験地区]
409
+
410
+ 'RC1![場] = "不使用項目"
411
+
412
+ Rc1![会場名] = StrConv(Rc2![会場名], vbWide)
413
+
414
+ Rc1![会場名略] = StrConv(Rc2![会場名略], vbWide)
415
+
416
+ Rc1![所在地] = StrConv(Rc2![所在地], vbWide)
417
+
418
+ Rc1![交通手段1] = StrConv(Rc2![交通手段1], vbWide)
419
+
420
+ Rc1![交通手段2] = StrConv(Rc2![交通手段2], vbWide)
421
+
422
+ Rc1![交通手段3] = StrConv(Rc2![交通手段3], vbWide)
423
+
424
+ Rc1.Update
425
+
426
+ ' End If
427
+
428
+
429
+
430
+ Rc2.MoveNext
431
+
432
+
433
+
266
- 特になし
434
+ Loop
435
+
436
+
437
+
438
+ End If
439
+
440
+
441
+
442
+ Exit_会場データインポート:
443
+
444
+
445
+
446
+ 'Set DB = Nothing
447
+
448
+ Set Rc1 = Nothing
449
+
450
+ Set Rc2 = Nothing
451
+
452
+ Set Rc3 = Nothing
453
+
454
+ Set XLAPP = Nothing
455
+
456
+ Set XLWRKBK = Nothing
457
+
458
+ Set XLWRKSH = Nothing
459
+
460
+
461
+
462
+ Exit Function
463
+
464
+
465
+
466
+ Err_会場データインポート:
467
+
468
+
469
+
470
+ 'エクセルのフリーズ防止
471
+
472
+ If XLAPP Is Nothing Then
473
+
474
+ Else
475
+
476
+ XLAPP.Quit
477
+
478
+ Set XLAPP = Nothing
479
+
480
+ End If
481
+
482
+
483
+
484
+ MsgBox "システムエラー 担当者に連絡して下さい。" & vbCrLf & Err.Description, vbOKOnly + vbCritical, MsgTitle
485
+
486
+ Resume Exit_会場データインポート
487
+
488
+
489
+
490
+ End Function
491
+
492
+
493
+
494
+
495
+
496
+ 'Callで呼び出し
497
+
498
+
499
+
500
+ Public Function エラーデータインポート(Optional 会場データ As String)
501
+
502
+
503
+
504
+ Dim Err_flg As Boolean
505
+
506
+
507
+
508
+ If Err_flg = False Then: Exit Function
509
+
510
+
511
+
512
+ Set Rc2 = CurrentDb.OpenRecordset("SELECT * FROM WK_会場マスター ORDER BY 会場コード")
513
+
514
+ Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")
515
+
516
+
517
+
518
+ Rc3.AddNew
519
+
520
+ Rc3![試験実施日] = Rc2![試験実施日]
521
+
522
+ Rc3![会場コード] = Rc2![会場コード]
523
+
524
+ Rc3![項目名] = "会場データ"
525
+
526
+ Rc3![項目内容] = Rc2!["会場データ"]
527
+
528
+ Rc3![文字数] = Len(Rc2!["会場データ"])
529
+
530
+ Rc3.Update
531
+
532
+ Err_flg = True
533
+
534
+
535
+
536
+ End Function
537
+
538
+
539
+
540
+ Public Function Err_flg() As Boolean
541
+
542
+ Set Rc3 = CurrentDb.OpenRecordset("T_会場エラーリスト")
543
+
544
+
545
+
546
+ If Rc3.RecordCount > 0 Then
547
+
548
+ Err_flg = True
549
+
550
+ Else
551
+
552
+ Err_flg = False
553
+
554
+ End If
555
+
556
+
557
+
558
+ End Function

1

追記した。

2024/04/10 05:45

投稿

tdpdjt1
tdpdjt1

スコア1

test CHANGED
@@ -1 +1 @@
1
- If文の中の同じ処理を簡潔に書きたい
1
+ If文の中の同じ処理を簡潔に書きたい。Functionプロシージャに渡す値を変えて、繰り返す処理にしたいが引数が上手く渡せなかった。
test CHANGED
File without changes