編集履歴

質問編集履歴

説明追加

2019/11/02 04:35

投稿

hachi3156

スコア16

title CHANGED Viewed

File without changes

body CHANGED Viewed

@@ -88,57 +88,11 @@
     Next CntRow
 End Sub
-Public Sub ReadDBData(ByVal TarObjToWRITE As String, ByRef ReadList() As Variant, ByRef WriteList() As Variant, ByVal strSQL As String)
-    Dim CntRow As Long
-    Dim readobj As Object
-    Dim writeobj As Object
-    Dim LengthOfArray As Long
-    Dim StartRow As Long
-    Dim EndRow As Long
-    Dim ADOCon As ADODB.Connection
-    Dim ADORes As ADODB.Recordset
-    Set ADOCon = initDb(ADODB_NAME, ADODB_PASS)
-    Set ADORes = New ADODB.Recordset
-    ADORes.Open strSQL, ADOCon
-    Dim reObj As returnObject
-    Set reObj = New returnObject
-    '----標準モジュール記載
-    Set reObj.Cls_ADORes = Createobject("ADODB.recordset")
-    Set reObj.Cls_Frm = UserForm1
-    '----
-    StartRow = 3
-    EndRow = 10
-    For CntRow = StartRow To EndRow
-        'リストの要素数
-        For LengthOfArray = LBound(ReadList) To UBound(ReadList)
-            Set readobj = reObj.SetObjToRead("FIELD", ReadList(), LengthOfArray, CntRow)
-            Set writeobj = reObj.SetObjToWrite(TarObjToWRITE, WriteList(), LengthOfArray, CntRow)
-            writeobj.Value = readobj.Value
-        Next LengthOfArray
-    Next CntRow
-End Sub
 ```
 ###クラスモジュール３ returnObject
 ```
 ・クラス変数
 Public Cls_ws As Worksheet
 Public Cls_ADORes As ADODB.Recordset
@@ -192,8 +146,153 @@
 ```
-###標準モジュール
+#修正
+追加の返信をいただく前に標準モジュールにしてしまいました。申し訳ないです。
+使用例：ワークシート→ユーザーフォーム間のデータのやりとり
+![イメージ説明](e6f1d9b8d456ff6e2fc80a3a80203e8a.png)
+アクティブシートのデータを取得したい行を「行番号」のテキストボックスに入力してから、「コピー元決定」ボタンを押すとcmdC_DecideParts_Clickが動きます
+データのやりとりを行うオブジェクトはSetObjToRead関数とSetObjToWrite関数で決めており、どのオブジェクトのどの要素をやりとりの対象とするのかを文字列として渡すことで目的のオブジェクトを決めています。
+(例：データを読み込みたい(値をコピーしたい)オブジェクトをアクティブシートの7行目にある品番列のRangeオブジェクトにする場合)
+→strTarObjName="CELL"、TarRowForCell=7,strTarElement="品番",TarObj=ActivesheetをSetObjToRead関数に引数として渡す
+セルをデータのやり取りの対象にしたい場合は単純に列番号を渡すと列の順番を変更できないので、さらにcolslctbytitle関数に列名を文字列として渡して、渡した文字列とシートの列名が一致したらそのときの列番号をcolslctbytitle関数の返り値としています
+ReadArray(),WriteArray()ではSetObjToRead関数とSetObjToWrite関数に渡すための文字列を決めています
+現状はShtToFrm関数のように(データの読み込み先：Worksheet)To(データの書き込み先:UserForm)として関数の名前を付けていますが、6パターン文の関数(ShtToFrm,FrmToSht,ShtToAccessDB,AccessDBToSht,FrmToAccessDB,AccessDBToFrm)
+(データの書き込み先がAccessDBの場合は新規追加と更新もあるので、さらに関数が増えそう)
+を作るのではなく、2,3つの関数にまとめられたらと考えています。
+ユーザーフォームのモジュール(FrmCopyContentsInfoOfParts)
+```ここに言語を入力
+Private Sub cmdC_DecideParts_Click()
+    Dim TarRow As Integer
+    TarRow = Me.txtRowNum.Value
+    Dim ReadArray() As Variant
+    Dim WriteArray() As Variant
+    '配列の要素はそれぞれ対応していなければならない(e.g:品番⇔txtC_PartNum)
+    ReadArray() = Array("品番", "図番", "図番改定", "品名", "型式名", "アキクラコード", "メーカー名", "メーカーコード", "仕入先", "仕入先コード", "標準原価単価", "標準発注単価", _
+                        "ロット発注", "ロット単位数", "部品_在庫小数桁", "在庫用発注_棚卸変換値", "標準発注LT", "製番製品No_ロットNo", _
+                        "部品単位", "発注単位", "品番分類", "在庫分類", "発注手配", "引当手配", "品番備考")
+    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", _
+                        "txtC_Lot", "txtC_LotQty", "txtC_Digit", "txtC_ConversionValue", "txtC_LT", "txtC_LotNo", _
+                        "txtC_PartsUnit", "txtC_OrderUnit", "txtC_PartNumClassCode", "txtC_StockClassCode", "txtC_OrderArrgtCode", "txtC_AllocArrgtCode", "txtC_Remark")
+    Call ShtToFrm(ReadArray(), WriteArray(), TarRow)
+End Sub
 ```
+以下、標準モジュール
+```ここに言語を入力
+Public Sub ShtToFrm(ByRef strArrayToRead() As Variant, ByRef strArrayToWrite() As Variant, ByVal TarRow As Long)
+    If UBound(strArrayToRead) <> UBound(strArrayToWrite) Then
+        MsgBox "読み込み先の配列の要素数と書き込み先の配列の要素数が違います" & vbCrLf & "処理を中止します"
+        Exit Sub
+    End If
+    Dim StartRow As Long
+    Dim LengthOfArray As Long
+    Dim ReadObj As Object
+    Dim WriteObj As Object
+    For LengthOfArray = LBound(strArrayToRead) To UBound(strArrayToRead)
+        Set ReadObj = SetObjToRead("CELL", ActiveSheet, strArrayToRead(LengthOfArray), TarRow)
+        Set WriteObj = SetObjToWrite("CONTROL", FrmCopyContentsInfoOfParts, strArrayToWrite(LengthOfArray))
+        WriteObj.Value = ReadObj.Value
+    Next LengthOfArray
+End Sub
+```
+前回ではSetObjToReadやSetObjToWriteに配列を渡していたので、それを配列内の文字列を直接渡すようにしたのですが、こうしてみるとShtToFrmにも配列で渡す必要なかったですね
+そうすれば、forループを関数の外で処理できそうです
+```ここに言語を入力
+Option Explicit
+Public Function SetObjToRead(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
+    'データを読み込む(コピーする)オブジェクトを選択
+    On Error GoTo Err
+    Select Case strTarObjName
+        Case "CELL"
+            Set SetObjToRead = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
+        Case "FIELD"
+            Set SetObjToRead = TarObj.Fields(strTarElement)
+        Case "CONTROL"
+            Set SetObjToRead = TarObj.Controls(strTarElement)
+    End Select
+    Exit Function
+Err:
+    Call ErrHndl(Err.Number, Err.Description)
+End Function
+Public Function SetObjToWrite(ByVal strTarObjName As String, ByVal TarObj As Object, ByVal strTarElement As String, Optional TarRowForCell As Long = 1) As Object
+    'データを書き込む(ペーストする)オブジェクトを選択
+    On Error GoTo Err
+    Select Case strTarObjName
+        Case "CELL"
+            Set SetObjToWrite = TarObj.Cells(TarRowForCell, ColSlctByTitle(strTarElement, TarObj))
+        Case "FIELD"
+            Set SetObjToWrite = TarObj.Fields(strTarElement)
+        Case "CONTROL"
+            Set SetObjToWrite = TarObj.Controls(strTarElement)
+    End Select
+    Exit Function
+Err:
+    Call ErrHndl(Err.Number, Err.Description)
+End Function
+Private Sub ErrHndl(ByVal ErrNum As Long, ByVal ErrDiscription As Variant)
+    Select Case ErrNum
+        Case Else
+            MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラーの種類:" & ErrDiscription
+    End Select
+End Sub
+```
+```ここに言語を入力
+Public Const StartRow = 5
 Public Function ColSlctByTitle(ByVal Title As String, ByVal ws As Worksheet, Optional ByVal DefaultRow As Integer = StartRow) As Integer
     Dim CountCol As Integer
@@ -218,30 +317,4 @@
     MsgBox (Err.Description)
 End Function
-Public Function initDb(ByVal FileName As String, ByVal FilePass As String) As ADODB.Connection
-    Dim ConnectionString As String          '接続文字列
-    Dim DbFilePass As String                'データベースファイルのパス
-    Dim DbFileName As String                'データベースファイルの名前
-    Dim ADOCon As ADODB.Connection          'データベース接続オブジェクト
-    Dim strCon As String
-    '接続文字列作成
-    ConnectionString = "Microsoft.ACE.OLEDB.12.0"
-    DbFileName = FileName & ".accdb"
-    Set ADOCon = New ADODB.Connection
-    ' 接続文字列を作成する
-    strCon = "Provider=" & ConnectionString & ";" & "Data Source=" & FilePass & DbFileName & ";"
-    '接続する
-    ADOCon.Open strCon
-    Set initDb = ADOCon
-End Function
 ```