【VBA】配列の結合

VBAとかってさ、いろいろ甘く作ってくれてるから、
簡単に配列を結合できるコマンドがあったりしないかな？思ったんだけど…
…どうやら無いらしいorz

そんなわけで、ぐぐってたら、配列の要素をつなげてString型にするJoin()と、
逆に、Stringをセパレータで切り分けて配列にするSplit()を組み合わせてできるらしい。

  Dim Arr_A As Variant
  Dim Arr_B As Variant
  Dim Arr_C As Variant
  
  Arr_A = Array("あ", "い")
  Arr_B = Array("う", "え", "お")
  
  Arr_C = Split(Join(Arr_A) & " " & Join(Arr_B))

要点だけ書くとこう。

ここで、やっとVariant型ってのがどーゆーモノか、わかった気がする。
…ボク、いままで、Arrayつかって配列要素書くとき、
Dim Arr_A() As Variant
って書いてたのだ。
Array()を調べたとき、Exampleがこー書かれていて、
しかも、Variant型にしか入れられませんよ。と、注釈されていたのだ。
わかった気がすると、コレで動くのもわかった気がするけど、
まず、釈然としないながらも丸写ししてたボクがゆるせず、
あの説明を書いたヤツを（2048MB省略）

つまりはVariantの変数は、アドレスが格納されている。
ArrayやSplitの返り値は、配列の先頭メモリアドレスだってーコトがやっと理解できた。
恐らくは、BooleanでもObjectでも叩き込めるのは、
Variant型に指定した変数のサイズが変わるんではなく、
参照先がかわるだけなんじゃないかな( ﾟ-ﾟ)~ﾟ（わかった気分

そんなわけでテスト

Public Sub JoinAndSplit()
  
  Dim Arr_A As Variant
  Dim Arr_B As Variant
  Dim Arr_C As Variant
  Dim i As Integer
  
  Arr_A = Array("あ", "い")
  Arr_B = Array("う", "え", "お")
  
  VerTypeCheck (Arr_C)  'Empty:Empty値 (未初期化)
  
  Debug.Print Join(Arr_A)
  Debug.Print Join(Arr_B)
  
  Arr_C = Split(Join(Arr_A) & " " & Join(Arr_B))

  For i = 0 To UBound(Arr_C)
   Debug.Print Arr_C(i)
  Next

  VerTypeCheck (Join(Arr_B)) 'String:文字列型
  VerTypeCheck (Arr_A(0))    'String:文字列型
  VerTypeCheck (Arr_C)       '配列:Variant:バリアント型 (バリアント型配列にのみ使用)

End Sub

納得の結果(*ﾟ-ﾟ) ちなみに、VerTypeCheck は、変数がナニモノかを知るボク作関数。
てゆか返り値はStringの方が使いやすいか。なにげによく使うのでそのうち変えよう。

…はて、文字列型はコレでいいとしてIntegerだったらどーすんだろ…
と、思い、ぺぺいっと…

Public Sub JoinAndSplit2()
  
  Dim Arr_A As Variant
  Dim Arr_B As Variant
  Dim Arr_C As Variant
  Dim i As Integer
  
  Arr_A = Array(1, 2)
  Arr_B = Array(3, 4, 5)
  
  VerTypeCheck (Arr_C)  'Empty:Empty値 (未初期化)
  
  Debug.Print Join(Arr_A)
  Debug.Print Join(Arr_B)
  
  Arr_C = Split(Join(Arr_A) & " " & Join(Arr_B))

  For i = 0 To UBound(Arr_C)
   Debug.Print Arr_C(i)
  Next

  VerTypeCheck (Join(Arr_B)) 'String:文字列型
  VerTypeCheck (Arr_A(0))    'Integer:整数型
  VerTypeCheck (Arr_C)       '配列:Variant:バリアント型 (バリアント型配列にのみ使用)

End Sub

おおお、Arr_A(0)がちゃんとIntegerになってる！！
すげーぜBASIC！！

って…ホントはLongにしたかったらどーすんだよ( ﾟ-ﾟ)~ﾟ
Array()で仕込むときにcastとかで明示的にできるんだろうか。
要素の一つを明示的に宣言した変数を入れりゃいいかも…？

…疑問は尽きないが、ねむいしめんどちいので、この件はココまで（ぉぃ

コントロールをまとめて表示/非表示にする

なんかの言語でやったんだ。
フレームにコントロールを並べてグループ化し、まとめて表示させたり非表示にさせたり。
ソレをAccessVBAでやりたいんだけどどーしたらいい？とぐぐったら、
『Accessでは用意されていない。コントロールを拾ってループ処理する。』
と、ゆー模範解答があった。

　『…実に興味深い。』

そこで、代替手段を考えてみた。
…５分後…ふつーにタブにコントロール乗せられるじゃん( ﾟ-ﾟ)~ﾟ

こんな感じ。タブの名前はタブ10。その中のページ”Test用”。

このタブの部分の名前＝表題として出てしまって、消すことは出来なかった。

Accessははみ出して配置できないのが難点かなぁ。

VBAからやろうとしたらなんか怒られたし。

そんなわけで、コマンドボタン９ぽちると、

Private Sub コマンド9_Click()
   タブ10.Visible = Not タブ10.Visible
End Sub

が、動いて、(True/Falseが入れ替わり)
タブ10と乗っかってるコントロールがまとめて出たり消えたりします。

もちろん、その後ろになにかコントロールを隠しておけば、それが表示されます。
複数のタブを重ねても、タブコントロールのVisibleを操作するだけなので、
複数のフォームを開くことなく、簡便にフォームの内容を変化させられます。

…いやまぁ、素直に別フォーム開いた方が遥かにキレイで簡便なんですが、
今回は手順をおって進める仕組みなので…( ﾟ-ﾟ)~ﾟ

　『ありえない？ありえないなんてありえない。』

変数やプロパティの型を知りたい

VarTypeって関数がある。
返り値と定数を比べろってぇモノ。大変不親切である。
まぁ、わりとなんでも融通利かせちゃうVBならこんなもんかと思わなくもない（ぉぃ
でも、ボクは明示的に宣言するのがスキである。あとで大事故にならないように。

そんなわけで、お手軽に調べられるよう、こんなモンをつくって、
標準モジュールに置いておくようにした。

Public Sub VerTypeCheck(ByRef Variable)
  Dim VarType_Number
  Dim Str_Return As String
  Str_Return = ""
  
  VarType_Number = VarType(Variable)
  If VarType_Number > vbArray Then
    Str_Return = "配列:"
    VarType_Number = VarType_Number - vbArray
  End If
  
  Select Case VarType_Number
    Case vbEmpty
      Debug.Print (Str_Return & "Empty:Empty値 (未初期化)")
    Case vbNull
      Debug.Print (Str_Return & "Null:Null値 (無効な値)")
    Case vbInteger
      Debug.Print (Str_Return & "Integer:整数型")
    Case vbLong
      Debug.Print (Str_Return & "Long:長整数型")
    Case vbSingle
      Debug.Print (Str_Return & "Single:単精度浮動小数点数型")
    Case vbDouble
      Debug.Print (Str_Return & "Double:倍精度浮動小数点数型")
    Case vbCurrency
      Debug.Print (Str_Return & "Currency:通貨型")
    Case vbDate
      Debug.Print (Str_Return & "Date:日付型")
    Case vbString
      Debug.Print (Str_Return & "String:文字列型")
    Case vbObject
      Debug.Print (Str_Return & "Object:オートメーション オブジェクト")
    Case vbError
      Debug.Print (Str_Return & "Error:エラー値")
    Case vbBoolean
      Debug.Print (Str_Return & "Boolean:ブール型")
    Case vbVariant
      Debug.Print (Str_Return & "Variant:バリアント型 (バリアント型配列にのみ使用)")
    Case vbDataObject
      Debug.Print (Str_Return & "DataObject:非OLEオートメーションオブジェクト")
    Case vbDecimal
      Debug.Print (Str_Return & "Decimal:10進数型")
    Case vbByte
      Debug.Print (Str_Return & "Byte:バイト型")
    Case vbArray
      Debug.Print (Str_Return & "Array:配列")
    Case Else
      Debug.Print (Str_Return & "???:わかんない:" & VarType(Variable))
  End Select

End Sub

VerTypeCheck 変数やプロパティ
とか、
Call VerTypeCheck(変数やプロパティ)
って呼び出してやると、Debugにナニモノかを吐き出してくれる。
仕様上、”Array:配列”が出力されるコトはないんだけど、一応Caseに含ませてある。
やってることは、まぁMSDNでゆってること丸写しなだけ( ﾟ-ﾟ)~ﾟ

WhsShellを使ってみる

カレントディレクトリを指定して外部実行ファイルを実行したくなった。
WhsShellオブジェクトで可能ぽい。
ついでにちょっと便利そうな、SpecialFolders一覧を出してみる。
そして、肩慣らしに、実行時バインディングで書いてみる。

Option Compare Database
Option Explicit

Public Sub WshShell_Test()
  Dim WshShell As Object 'WshShell Object
  '実行する実行ファイル or 拡張子に関連付けされていればそのプログラムが開く。
  Dim Wsh_exe As String  
  Dim Wsh_arg As String  '引数用
  
  Set WshShell = CreateObject("WScript.Shell")
  With WshShell
    '    SpecialFolders の表示
    Debug.Print "AllUsersDesktop:" & .SpecialFolders("AllUsersDesktop")
    Debug.Print "AllUsersStartMenu:" & .SpecialFolders("AllUsersStartMenu")
    Debug.Print "AllUsersPrograms:" & .SpecialFolders("AllUsersPrograms")
    Debug.Print "AllUsersStartup:" & .SpecialFolders("AllUsersStartup")
    Debug.Print "Desktop:" & .SpecialFolders("Desktop")
    Debug.Print "Favorites:" & .SpecialFolders("Favorites")
    Debug.Print "Fonts:" & .SpecialFolders("Fonts")
    Debug.Print "MyDocuments:" & .SpecialFolders("MyDocuments")
    Debug.Print "NetHood:" & .SpecialFolders("NetHood")
    Debug.Print "PrintHood:" & .SpecialFolders("PrintHood")
    Debug.Print "Programs:" & .SpecialFolders("Programs")
    Debug.Print "Recent:" & .SpecialFolders("Recent")
    Debug.Print "SendTo:" & .SpecialFolders("SendTo")
    Debug.Print "StartMenu:" & .SpecialFolders("StartMenu")
    Debug.Print "Startup:" & .SpecialFolders("Startup")
    Debug.Print "Templates:" & .SpecialFolders("Templates")
  End With
  WshShell.currentdirectory = "c:\"  'カレントディレクトリを設定してみる
  '実行ファイルは、cmd.exe。環境変数%ComSpec%からとってきてみる
  Wsh_exe = Environ("ComSpec")
  '起動オプション。　コマンド"set"を実行→ウィンドウを閉じない
  Wsh_arg = " /K set"

  'ウィンドウをふつーに開いて、終了を待たない。
  WshShell.Run Wsh_exe & Wsh_arg, 1, False
End Sub

こんな感じ。( ﾟ-ﾟ)~ﾟ　※Wsh_arg = "(こっそりスペース)/K set"
SpecialFoldersや環境変数の他、コマンドプロンプトで、
カレントディレクトリが指定したディレクトリに移動しているコトも確認してください。

…SpecialFoldersは、DesctopとMyDocumentsしか使わなそう。
てゆかそれならEnviron(”USERPROFILE”) & "\Desctop"の方が手っ取り早いか( ﾟ-ﾟ)~ﾟ
いいもの見つけたと思ったのにゴミだったorz

なんかさ、.Runの引数の説明頑張ってくれてる人や、ADODBの記事みたりしてる中で、

ここの引数は文字列型なので、”（ダブルクォーテーション）でくくらなきゃいけない！
とか、"でエスケープするので”””としなきゃいけない！！
とか、chr(34)とかキャラクターコードで！！！
とか、'（シングルクォーテーション）と組み合わせて！！！！

とか、いろいろ気合入ってる方々がいました。
んなもん、ふつーにString型変数にいれりゃーいいじゃん( ﾟ-ﾟ)~ﾟと…
ちなみにMSDNでもこうやって変数に入れてRunさせてました。

まぁ例えば、ダブルクオーテーション付きcsvのように、
ダブルクオーテーション自体を使いたい場合は、
ふつーに
Private Const WQ = """"
とか
Dim WQ as String
WQ = """"
とかしといて文字列連結すりゃ、そーそーややこしいコトにはならないと思うのだが。

オブジェクトまたはクラスがイベントのセットをサポートしていません。

コレは、office2003なんてゆーモンを使ってるせいでおきたモノ。
なかなか同じ状況に陥る人はいないとおもうんだけど一応メモ(笑

VBAを実行させ、ボタンとかでイベント発生させると、
(そのイベントの動作についての説明)＋
オブジェクトまたはクラスがイベントのセットをサポートしていません。
とかぬかしてキンコンカンコン鳴るようになってしまった。

おそらく原因は、既存のバグ
実行時エラー '3709'
この動作を実行するために接続を使用できません。
このコンテキストで閉じているかあるいは無効です。
に対応するパッチ。

なんか普通にPatch当たるだけじゃなく、Access起動時にも何回かなんかしてました。

で、ソレがでなくなったら
オブジェクトまたはクラスがイベントのセットをサポートしていません。
の症状。
MSDNに解決法が載っていて、MSACCESS.EXEを管理者で実行すれ！とのこと。
んまぁいいんだけどね…
ちなみに、office12なんてフォルダが出来てて、中にもMSACCESS.EXEがあった。
単独では起動出来ないんだけど、引数にmdbファイルを渡してやると、
あの、悪名高き、左上にWindowsマークのある、フォームが開いた(笑

まぁ正直、ボクは現行のリボン方式もいまいち馴染めてない（探せない）のだけれどもね（笑

CopyFileとFileCopy

VBAでファイルをコピーしたい。
でも、書き込み先が、ReadOnlyで開いていて書けないコトがある。
とゆー状況。
FileCopyステートメントを使ったら頻繁に実行時エラーが出てしまう。
on Error GoToでエラー処理するようcodingしてみた。

On Error GoTo ErrorHandlerSJ
    FileCopy source, destination
    Shell_Return = Shell(browser_exe, vbNormalFocus)
Exit Sub
ErrorHandlerSJ:
    MsgBox ("ErrorSJ")
Exit Sub

…なんか、美しくないな…( ﾟ-ﾟ)~ﾟ
やっぱりね、プロシージャの途中で終わるなんての、ダメだよね。
やっぱりね、返り値で成否を教えてくれないステートメントなんか使うのが
いけないよね。

そんなわけで、ちゃんと返り値で教えてくれる、おりこうさんな、
FileSystemObjectのCopyFileメソッドを使ってみた。
…実行時エラーでやがりましたorz
美しくないぜMicrosoft！

そんなわけで、

Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
(中略)
On Error Resume Next
FSO.CopyFile source, destination
Select Case Err.Number
  Case 0
    Shell_Return = Shell(browser_exe, vbNormalFocus)
  Case Else
    MsgBox ("ErrorSJ:" & Err.Number)
End Select

こーなりました。

でも、入れ子になったりしたら、

On Error GoToですっ飛ばして終わりにしたほうがキレイなんだろうなぁ…

ちなみに、FileSystemObjectを使うには、参照設定に、Microsoft Scripting Runtimeが必要です。MSDNに書いてなくて探した探した(笑

もちろん、実行時バインディングすれば参照設定はいりません。

…ふと思ったんだけど、VBAの場合は実行時バインディングの方がいいんじゃなかろうか。

よほど多量じゃない限り、オーバーヘッドなんかたかが知れてるし、

違う環境(参照設定していないマシン)でも動くモノを～と考えると、

実行時バインディングの方が有利なんじゃないかと…

人様向けに作るときに改めて考えてみよう( ﾟ-ﾟ)~ﾟ

AccessアクセスClassをVBAに移植してみた～Class本体～

けっこー大変だったorz
書式を直すだけなら、ふつーに正規表現とかでぱたぱたと出来たのだけど、
なにしろボクはVBAのお約束を知らない。
参照渡しをSetにするとかゆーのは、あちこちで見かけたので問題なかったのだけど、
まさか、引数を渡すのに括弧つけちゃダメな言語があったとはっ！と…
あとアレだ。Class内部のコーディングのミスを、
呼び出し側のPropertyの設定ミスとしてエラー吐くのはどうよ。
そこカプセル化しちゃダメだよね？てなトコロ。
Openさせたときにエラー吐かせて拾おうとしたら、
Class内部でのエラー回避処理には引っかからず、
Open Method読んでるトコでエラー吐くし。内部でのチェック意味ねー( ﾟ-ﾟ)~ﾟ

仕上がりはけっこーおざなり。
とりあえず動いたからいいや的な作りなので、丸写しで追求しないか、
使いやすいようカスタマイズしてください( ﾟ-ﾟ)~ﾟ

参考：AccessアクセスClassをVBAに移植してみた～呼び出し側～


(Class Module : SetDBtoTable )

Option Explicit
'指定したDBを読み込み、テーブルで返す。
'----------
'Variable
'----------
Private m_Provider As String
Private m_DataSource As String
Private m_ConnectionString As String
Private m_UserID As String
Private m_Password As String
Private m_RecordCount As Integer
Private m_ColumnCount As Integer
Private m_DataTable() As String  'テーブルデータ格納場所
Private cn As ADODB.Connection
Private rs As ADODB.Recordset
'----------
'Property
'----------
'------------------------------
'DBへアクセスするために必要なProperty群
'------------------------------
'プロバイダ指定。Accessなら"Microsoft.Jet.OLEDB.4.0;"みたいなの
Property Get Provider() As String
  Provider = m_Provider
End Property
Property Let Provider(Provider As String)
  m_Provider = Provider
End Property
'データソース指定。Accessならファイル名
Property Get DataSource() As String
  DataSource = m_DataSource
End Property
Property Let DataSource(DataSource As String)
  m_DataSource = DataSource
End Property
'コネクションストリング。テーブル名だったりSQLだったり
Property Get ConnectionString() As String
  ConnectionString = m_ConnectionString
End Property
Property Let ConnectionString(ConnectionString As String)
  m_ConnectionString = ConnectionString
End Property
'ユーザーID。テストしてないから動くかどうかわからない( ﾟ-ﾟ)~ﾟ
Property Get UserID() As String
  UserID = m_UserID
End Property
Property Let UserID(UserID As String)
  m_UserID = UserID
End Property
'パスワード。テストしてな（以下略
Property Get Password() As String
  Password = m_Password
End Property
  Property Let Password(Password As String)
m_Password = Password
End Property
'------------------------------
'得たデータを参照するProperty群
'------------------------------
'レコード数
Property Get RecordCount() As Long
  RecordCount = m_RecordCount
End Property
'カラム数
Property Get ColumnCount() As Long
  ColumnCount = m_ColumnCount
End Property
'Value Override群 Start…って思ったら、Overrideできないでやんの( ﾟ-ﾟ)~ﾟ
Property Get Value() As String()
  Value = m_DataTable
End Property
'Item Override群 Start Default Property指定。Default指定もできないでやんの
Property Get Item(ByVal i As Integer, ByVal j As Integer) As String
  Item = m_DataTable(i, j)
End Property
Property Get Record(ByVal i As Integer) As String()
  Record = m_Record(i)
End Property
Property Get Column(ByVal j As Integer) As String()
  Column = m_Column(j)
End Property
'----------
'Constructor
'----------
Private Sub Class_Initialize()
  Debug.Print ("Constructor:" & TypeName(Me))
  m_Provider = "Microsoft.Jet.OLEDB.4.0;"
End Sub
'----------
'Destructor
'----------
Private Sub Class_Terminate()
  Debug.Print ("Destructor:" & TypeName(Me))
End Sub
'----------
'Method
'----------
'DBにアクセスし、レコード数、カラム数、データ本体を読み込み、Class変数に代入
Public Function OpenDB() As Boolean
  Dim OnOK As Boolean
  OnOK = True
  Set cn = New ADODB.Connection
  Set rs = New ADODB.Recordset
  Dim i As Integer
  Dim j As Integer
  cn.Provider = m_Provider
  '_ConnectionStringが空か確認。空であればエラーを吐きFalseを返してMethod終了
  If m_ConnectionString = "" Then
    Debug.Print ("ERROR:" & TypeName(Me) & ":ConnectionString Property Not Assignment")
    OnOK = False
    OpenDB = OnOK
  End If
  'DataSourceが空か確認。空であればエラーを吐きFalseを返してMethod終了
  If m_DataSource = "" Then
    Debug.Print ("ERROR:" & TypeName(Me) & ":DataSource Property Not Assignment")
    OnOK = False
    OpenDB = OnOK
    Exit Function
  End If
  'DataSource設定
  cn.Properties("Data Source").Value = m_DataSource
  'ID/Passwd設定（試してない
  If m_UserID <> "" Then
    cn.Properties("UserID").Value = m_UserID
  End If
  If m_Password <> "" Then
    cn.Properties("Password").Value = m_Password
  End If
On Error GoTo Error_Handler
  cn.Open
'ConnectionString(テーブ名やSQL。DELETEとか書かれても、
'rs.open()のときにReadOnlyで開くからはじけると思う
  rs.Source = m_ConnectionString
  rs.ActiveConnection = cn
  rs.CursorType = ADODB.CursorTypeEnum.adOpenKeyset
  rs.LockType = ADODB.LockTypeEnum.adLockReadOnly
  rs.Open
  m_RecordCount = rs.RecordCount
  m_ColumnCount = rs.Fields.Count
  ReDim m_DataTable(m_RecordCount - 1, m_ColumnCount - 1)
  i = 0
  Do Until rs.EOF
    For j = 0 To m_ColumnCount - 1
      m_DataTable(i, j) = rs.Fields(j).Value
    Next j
    rs.MoveNext
    i = i + 1
  Loop
  OpenDB = OnOK
  Exit Function
  
Error_Handler:
  'Try中のエラーのとき cnとrsのopen、データ取り込み時それぞれで節を分ければError位置が特定できる。はず。
  Debug.Print ("ERROR:" & TypeName(Me) & ":DB or RS Open failed")
  OnOK = False
Error_Handler_End:
  OpenDB = OnOK
End Function
'クローズ。ホントは必要なさそうなんだけど、OpenしたからにはCloseしたくなるのは本能。
'VBAはちゃんとデストラクタくんが動いてくれるのでcallはしない。。
Public Sub CloseDB()
  rs.Close
  cn.Close
  Erase m_DataTable
End Sub
Public Sub putData()
  rs.MoveFirst
  ActiveCell.CopyFromRecordset rs
End Sub
Public Sub putRange(Arg_Range As String, Optional Worksheet As String)
  rs.MoveFirst
  If Worksheet = vbNullString Then
    ActiveSheet.Range(Arg_Range).CopyFromRecordset rs
  Else
    Worksheets(Worksheet).Range(Arg_Range).CopyFromRecordset rs
  End If
End Sub
Public Sub putCells(ByVal Row As Integer, ByVal Col As Integer, Optional ByVal Worksheet As String)
  rs.MoveFirst
  If Worksheet = vbNullString Then
    ActiveSheet.Cells(Row, Col).CopyFromRecordset rs
  Else
    Worksheets(Worksheet).Cells(Row, Col).CopyFromRecordset rs
  
  End If
End Sub
'----------
'Private Function
'----------
'データ要素単体渡し。stringで返す。範囲外のINDEX渡すと怒られるぞ。
Private Function m_Item(ByVal i As Integer, ByVal j As Integer) As String
  m_Item = m_DataTable(i, j)
End Function
'INDEXのRecordの要素全てを、Stringの１元配列型で返す。
Private Function m_Record(ByVal i As Integer) As String()
  Dim ReturnTable() As String
  Dim j As Integer
  ReDim ReturnTable(m_ColumnCount - 1)
  For j = 0 To m_ColumnCount - 1
    ReturnTable(j) = m_DataTable(i, j)
  Next j
  m_Record = ReturnTable
End Function
'INDEXのColumnの要素全てを、Stringの１元配列型で返す。
Private Function m_Column(ByVal j As Integer) As String()
  Dim ReturnTable() As String
  Dim i As Integer
  ReDim ReturnTable(m_RecordCount - 1)
  For i = 0 To m_RecordCount - 1
    ReturnTable(i) = m_DataTable(i, j)
  Next i
  m_Column = ReturnTable
End Function

AccessアクセスClassをVBAに移植してみた～呼び出し側～

Overrideとかできなかったので、ちょっと機能縮小気味だけど、
セルのMethodにCopyFromRecordsetなんてのがあって、
OpenしてあるRecordsetからごっそりデータを貼り付けられる。
ソレをメソッド化してみた。

Excel用に追加したMethod。
.putData
　：ActiveSheetのActiveCellを左上としてテーブル貼り付け
.putCells(ByVal Row As Integer, ByVal Col As Integer, Optional ByVal Worksheet As String)
　Worksheets(Worksheet ).Cells(Row,Col)を左上としてテーブル貼り付け
　※Worksheetを省略すると、ActiveSheetに
.putRange(Arg_Range As String, Optional Worksheet As String)
　Worksheets(Worksheet ).Range(Range)を左上としてテーブル貼り付け
　※Worksheetを省略すると、ActiveSheetに

クラス本体はこちら：AccessアクセスClassをVBAに移植してみた～Class本体～

呼び出し側

Option Explicit
Sub ボタン1_Click()
  Dim DB As SetDBtoTable
  Set DB = New SetDBtoTable
  DB.DataSource = "\LANDISK1\share\Test.mdb"
  DB.ConnectionString = "SELECT ID,Name,Order FROM T_Master ORDER BY Order;"
  DB.OpenDB
  
  DB.putData
  DB.putCells 16, 5, "Sheet1"
  DB.putRange "H36"
  DB.CloseDB
End Sub

VBAの複数の引数の渡し方～カッコつけてんじゃねぇよ！～

なんかね、ExcelVBAで、メソッドにうまく引数を渡せなくてハマった。
複数の引数渡すのに『カッコつけちゃダメ』なんてダサすぎだろ( ﾟ-ﾟ)~ﾟ

'(test class)
Public Sub test(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer)
  Debug.Print a + b + c
End Sub
'(呼び出し)
Private Sub CommandButton2_Click()
  Dim test As New testClass
  test.test 1, 2, 3  '←ココ( ﾟ-ﾟ)~ﾟ
End Sub

括弧つけると、=を入れろとか、無理矢理動かすと構文エラーとか…

どうやら、()は演算子として処理されるらしい。

だったら、構文の補助みたいんので、括弧表示するなよなー！

…ふと思ったんだけどN88BASICのGOSUB文って引数って渡せたっけ？
今思うと出来なかった気がする…てゆかそもそも構造化言語ですらなかったか。ないな(笑

エラー回避してみる

Mainフォームにデータソースを設定して、移動ボタンとかで、
カレントレコードが変わったら起こるイベントに、コードを書いた。
UserIdをココに入れなさい。と。
Mainフォームで普通にカレントレコードを移動させてれば、問題なく動く。
よしよし(*ﾟ-ﾟ)

しかし、ボタンから別フォームを呼び出し、その別フォーム側から、
(close時に)MainフォームをRequeryしたら、

『実行時エラー '2113' このフィールドに入力した値が正しくありません。』

が出た。
とりあえず切り分けのため、Debug.Print RecordSet!UserId してみたら、

『実行時エラー  '3021'カレントレコードがありません。』

なんですと！？

そんなわけで、Record数、EOF、BOFを表示してみる。
RecordSet.RecordCount　→　７（正常
RecordSet.EOF　→False（EOFではない
RecordSet.BOF　→False（BOFではない

…正常すぎじゃん( ﾟ-ﾟ)~ﾟ

こりゃ判断出来ないわってんで、エラー拾ってスルーするようにしました。

Private Sub Form_Current()
  '子フォームでRequeryされたとき、カレントレコードが取得できないので回避させる。
  On Error Resume Next
  Cmb_UserId.Value = Me.Recordset!UserId
  Select Case Err.Number
    Case 0      '正常
    Case 2113 'このフィールドに入力した値が正しくありません。
    Case 3021 'カレントレコードがありません。
    Case Else
      Debug.Print ("ERROR:" & Err.Number)
  End Select
  
  On Error GoTo 0
End Sub

ミソは、まず、On Error Resume Next で、『エラーが置きても次へ進む』指定と、
Select文でErr.Numberで、通していいエラー番号ダケをCaseに書き、

それ以外はエラー処理をするコト。

最後に、On Error GoTo 0 で、

『エラーを普通に拾ってくれるモード』に戻さないと楽しいコトになります( ﾟ-ﾟ)~ﾟ

ただスルーするのはキケンだし、

個人的にイヤ（コッチが重要）なのでこうしました( ﾟ-ﾟ)~ﾟ

通しちゃダメなその他エラーは、Msgboxで表示させるのが親切かも。

エラーコードからエラー内容を引っ張れるなら、エラーダイヤログと同じよーな動きさせるのも可能かもしれません。めんどちいのでやらないけど（ぇ

追記：
しまった。正常時のエラーコード０のcase書くのを忘れてた(*ﾟ-ﾟ)

テキストボックスをラベルみたいに扱う

ボクは閲覧する画面で編集できてしまうなんて仕組みは怖いと思っている。

しかし、帳票フォームやデータシート形式＋レコードソースで連結の形は、
大変便利で、使わざるを得ない。てゆか、コレがあるからAccessはタダのRDBではない。

そんなわけで、通常作られるテキストボックスを【コントロールの種類の変更】
してラベルにしてみたら、連結がとけやがりました( ﾟ-ﾟ)~ﾟ

そこで、TextBoxをLavelのようにしてみよう。ってのがコレ。

Public Sub Txtbox_Like_Lavel(obj As TextBox)
  With obj
    .TabStop = False
    .IMEHold = False
    .IMEMode = acImeModeOff
    .Locked = True
    .Enabled = False
    .BackStyle = 0
    .BorderColor = 0
    .BorderStyle = 0
  End With
End Sub

タブストップ外したり、色を変えたり、

入力できないようにプロパティを一括変換しています。

IMEとか関係ないけど、イヤだからOFF( ﾟ-ﾟ)~ﾟ（なにが？

ワクとか背景とかの色などお好みで変更可。

サイズの統一化とかもプロパティ追加すればOK。

そんなわけで使い方。

まずこのmoduleを、標準モジュールに置きます。

ボクは今後も使うので、CommonModuleって大胆な名前をつけました。

そして、フォームモジュール内から、

  Call Txtbox_Like_Lavel(名前)

※[名前]はコントロール名

てな感じに呼び出すだけ。

ちなみに、一回呼び出して、フォームを保存してしまえば、毎回呼ぶ必要はないので、

※ってごめんなさい！！VBAで設定できてもフォーム保存で保存されない、
　フォームデザインでしか設定できないプロパティがあります！
　てゆか、たくさんあります！！
　毎回呼び出すか、フォームデザインで頑張ってくださいorz

Private Sub Form_Formatting()
  Call Txtbox_Like_Lavel(ID)
  Call Txtbox_Like_Lavel(名前)
End Sub

個人的には、とかしておいて、以降どこからも呼ばれないけど、

こんな設定したゼぉぅぃぇ的モジュールをメモ代わりに残しておくのが好みです。

だってほら、フォームビューって、可読性最悪じゃん？( ﾟ-ﾟ)~ﾟ

【Debug】VBA内でSQLを発行する

T_名前マスター([UserId],[名前],[表示順序])と、ComboBoxがあるとする。

コンボボックスに指定されたUserIdは出力しない例。

Private Sub Exp_SQL_Com()
  Dim Str_SQL As String
  Dim rs As New ADODB.Recordset

'SQL文を文字列で作ってやる。
  Str_SQL = "SELECT UserId, 名前 FROM T_名前マスター WHERE UserId  <> " & _
                     Me!ComboBox.Value & " ORDER BY 表示順序;"

'ちゃんとSQL構文になっているか確認。よく変数名がそのまま出てたり( ﾟ-ﾟ)~ﾟ
  Debug.Print Str_SQL
  rs.Open Str_SQL, CurrentProject.Connection
  Do Until rs.EOF
    Debug.Print rs![名前]
    rs.MoveNext
  Loop
  rs.Close
End Sub

こんな感じに、イミディエイトウィンドウにSQL文や結果を排出。

後から動的に値集合ソースなどを指定するときの確認に便利。かも？

ggrks～Accessのプロパティの調べ方メモ

［Access Property コントロール名 日本語プロパティ名］【検索】ぽち
MSDNが引っかかってくるので参考にしてください。

…なんで、フォームデザインビューのプロパティ名を
無理矢理日本語にしてあるんだろう( ﾟ-ﾟ)~ﾟ