SSブログ

EXCEL VBA備忘録 ACCESS連携 [EXCEL]

リファレンスはまずはここを見る?
https://docs.microsoft.com/ja-jp/office/vba/api/overview/excel

何と言いますか今更ですが、エクセルVBAをやってみたんですよん。

2019-10-29.png意外と使える!と言うかデータ収集してエクセルにダイレクトにシートやセルに代入できるのは、やはり魅力的なので。

プログラムの観点からエクセルを理解するのは、おもしろいかもしれない!


ACCESS連携
!ACCESSのテーブルを展開する。※クエリでも同じ
  ' データベースを開く
  Dim DBE As Object, DB As Object, buhinRS As Object
  Set DBE = CreateObject("DAO.DBEngine.120")
  Set DB = DBE.OpenDatabase(filePath)  ' filePathはACCESSのデータベースへのファイルパス
  Set buhinRS = DB.OpenRecordset("部品")  ' 部品テーブルを引っ張る
  Dim recordCount As Long
  recordCount = buhinRS.recordCount - 2  ' レコードの数を取得するが、なぜか2多い
  
  '書式再設定 テーブルのフィールドタイプの合わせる
  Worksheets("BUHIN").Range("A2", Worksheets("BUHIN").Cells(recordCount+2, 1)).NumberFormatLocal = "0"
  Worksheets("BUHIN").Range("B2", Worksheets("BUHIN").Cells(recordCount+2, 2)).NumberFormatLocal = "yyyy/mm/dd"
  Worksheets("BUHIN").Range("C2", Worksheets("BUHIN").Cells(recordCount+2, 3)).NumberFormatLocal = "0"
  Worksheets("BUHIN").Range("D2", Worksheets("BUHIN").Cells(recordCount+2, 4)).NumberFormatLocal = "@"
  Worksheets("BUHIN").Range("E2", Worksheets("BUHIN").Cells(recordCount+2, 5)).NumberFormatLocal = "0"
  Worksheets("BUHIN").Range("F2", Worksheets("BUHIN").Cells(recordCount+2, 6)).NumberFormatLocal = "@"
  
  ' フィールド個別にセルに代入していく
  Dim row As Long
  row = 2
  Do Until buhinRS.EOF
    Worksheets("BUHIN").Cells(row, 1).Value = buhinRS(0)
    Worksheets("BUHIN").Cells(row, 2).Value = buhinRS(1)
    Worksheets("BUHIN").Cells(row, 3).Value = buhinRS(2)
    Worksheets("BUHIN").Cells(row, 4).Value = buhinRS(3)
    Worksheets("BUHIN").Cells(row, 5).Value = buhinRS(4)
    Worksheets("BUHIN").Cells(row, 6).Value = buhinRS(5)
    
    row = row + 1
    buhinRS.MoveNext
  Loop

  buhinRS.Close
  Set buhinRS = Nothing
  DB.Close
  Set DB = Nothing

!データの並び替え
データベースとは関係ないが、どちらかと言えば人間が見やすくする為にレコードの並び替えをする。
  ' データソート
  Worksheets("BUHIN").Range("A2", Worksheets("BUHIN").Cells(row, 6)) _
    .Sort Key1:=Worksheets("BUHIN").Range("C1"), order1:=xlAscending

!検索
並び替えの次は検索でしょう!Rangeで範囲指定しないと、トンでもな結果になる。すごく悩んだ。
codeが検索したい文字
  Dim Obj As Object
  Set Obj = Worksheets(sheet).Range("C2", Worksheets(sheet).Cells(downCell.row, 2)).Find( _
        After:=Worksheets(sheet).Range("C2"), _
        What:=code, _
        LookIn:=xlValues, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByColumns)
  
  If Obj Is Nothing Then
  ' 見つからなかった時の処理
  Else
  ' 見つかった時の処理
  End If


以下、順次追加

今読んでいる本

Excel VBAの教科書 (Informatics & IDEA)

Excel VBAの教科書 (Informatics & IDEA)

  • 作者: 古川 順平
  • 出版社/メーカー: SBクリエイティブ
  • 発売日: 2018/07/21
  • メディア: 単行本



気になっている本

パーフェクトExcel VBA (PERFECT SERIES)

パーフェクトExcel VBA (PERFECT SERIES)

  • 作者: 高橋 宣成
  • 出版社/メーカー: 技術評論社
  • 発売日: 2019/11/25
  • メディア: 単行本(ソフトカバー)



nice!(0)  コメント(0) 

EXCEL VBA備忘録 制御しよう! [EXCEL]

リファレンス先として、まずはここ?
https://docs.microsoft.com/ja-jp/office/vba/api/overview/excel

何と言いますか今更ですが、エクセルVBAをやってみたんですよん。

2019-10-29.png意外と使える!と言うかデータ収集してエクセルにダイレクトにシートやセルに代入できるのは、やはり魅力的なので。

プログラムの観点からエクセルを理解するのは、おもしろいかもしれない!


制御関連
!時間待ち
Public Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) 
    Sleep (100)  ' 100ms待ち
    DoEvents  ' エクセルに制御を返す

!時間の取得
  Dim startTimer As Double
  startTime = Timer

!シリアル通信タイムアウト設定
'SetCommTimeouts
Private Type COMMTIMEOUTS
    ReadIntervalTimeout As Long         ' 文字間の受信の待ち時間
    ReadTotalTimeoutMultiplier As Long  ' 受信文字数
    ReadTotalTimeoutConstant As Long    ' 固定受信待ち時間
    WriteTotalTimeoutMultiplier As Long ' 送信文字数
    WriteTotalTimeoutConstant As Long   ' 固定送信待ち時間
End Type

Private Declare PtrSafe Sub SetCommTimeouts Lib "kernel32" _
   (ByVal hfile As Long, _
          lpCommTimeouts As COMMTIMEOUTS)

  'configure com port timeout.
  ct.ReadIntervalTimeout = 0  ' 1000
  ct.ReadTotalTimeoutMultiplier = 1  ' 1
  ct.ReadTotalTimeoutConstant = 10  ' 500
  ct.WriteTotalTimeoutMultiplier = 1
  ct.WriteTotalTimeoutConstant = 500
  SetCommTimeouts hfile, ct

※1byteずつ文字を取得する様な場合は、このタイムアウトを適切に設定しないといけない。

!デバック中にCOM PORTを掴んだままプログラムが終了してしまった!
何も対策をしていないと一旦ワークシートを閉じないとCOM PORTの再利用ができない。
Subプロシージャ等でイベントドリブンでプログラムが動いているなら、COM PORTをオープンした時のハンドルをワークシートの一部とか大域変数にコピーして、次のCOM PORTオープンで失敗したらそのバックアップしたハンドルでクローズすると、わりと上手く行く。
以下はワークシートにバックアップした例。
  ' open com port.
  Dim hDev0 As Long
  hDev0 = comPortOpen(comPort, baud)
  If hDev0 = -1 Then
    MsgBox "Can't Open COM" & comPort
    If ActiveSheet.Range(COM_PORT_HANDLE_INPUT).Value <> "" Then
      hDev0 = ActiveSheet.Range(COM_PORT_HANDLE_INPUT).Value
      CloseHandle hDev0
    End If
    GoTo ENDOfButton1Click
  End If
  ActiveSheet.Range(COM_PORT_HANDLE_INPUT).Value = hDev0

!ワークシート上のボタンをいじる
  Worksheets("sheet1").Buttons(1).Caption = "受信中"  ' キャプションの変更
'  Worksheets("sheet1").Buttons("ボタン1_Click").Caption = "受信中"    ' 上手く行かない
'  Worksheets("sheet1").Buttons(1).Visible = False  ' シート上から消える

!データ受信に専念する
データ受信中もワークシート上のグラフとかはセルの内容に応じて再描画されてしまい、全体の処理が遅くなってしまうので、その再描画の抑制をしてみる。
' 再計算を行うの?行わないの?
' no return value.
Function verbosedSheet(ByVal yesNo As Boolean)
  If yesNo Then
    Application.Calculation = xlCalculationAutomatic
'    Application.ScreenUpdating = True  ' これを行うと本当に画面の変化が無くなる
    Application.EnableEvents = True
  Else
    Application.Calculation = xlCalculationManual
'    Application.ScreenUpdating = False  ' これを行うと本当に画面の変化が無くなる
    Application.EnableEvents = False
  End If
End Function

!一行分のCSVデータをセルに代入
' write csv data to cells.
' no return value.
Function writeCSVDataToCell(ByVal y As Integer, ByVal x As Integer, ByVal line As String)
  Dim arr() As String
  arr = Split(line, ",")
  Dim argc As Integer
  argc = UBound(arr)
  ReDim Preserve arr(argc)
  
  Dim i As Integer
  For i = 1 To argc
    If arr(i - 1) <> "" Then
      ActiveSheet.Cells(y, x).Value = arr(i - 1)
      x = x + 1
    End If
  Next
End Function

!ワークシートを開いたり閉じたりした時になにかをさせる。
Private Sub Workbook_Open()  ' 起動時実行ハンドラ
Private Sub Workbook_BeforeClose(Cancel As Boolean)  '終了時実行ハンドラ

!ワークシートの縦横のサイズを取得
  Dim rowSize As Long
  rowSize = Rows.Count  ' ワークシートの横方向の大きさを返すプロパティ
  Dim colSize As Long
  colSize = Columns.Count  ' ワークシートの縦方向の大きさを返すプロパティ
  MsgBox "row size = " & rowsize
  MsgBox "col size = " & colsize

!指定したセルから、各方向の値が含まれる最後のセルを取得する。
  '  xlDown:下方向 xlToRight:右方向 xlToLeft:左方向 xlUp:上方向
  Dim range1 As Range

  Set range1 = ActiveSheet.Range("C3").End(xlDown)
  Set range1 = ActiveSheet.Cells(3, 3).End(xlDown) ' または
  range1.Value = "下端のセル"

  Set range1 = ActiveSheet.Range("C3").End(xlToRight)
  Set range1 = ActiveSheet.Cells(3, 3).End(xlToRight)  ' または
  range1.Value = "右端のセル"

※上記のセルのrowとcolumnを得るには、それぞれのrangeのcolumnプロパティとrowプロパティを参照する。range1.Columnとかrange1.rowとか。以下の様に!
Sub recieveAreaClear()
  Dim downCell As Range, rightCell As Range
  Set downCell = ActiveSheet.Range("A3").End(xlDown)
  Set rightCell = ActiveSheet.Range("A3").End(xlToRight)
  
  Dim col As Long, row As Long
  col = rightCell.Column
  row = downCell.row

  ' MsgBox "col = " & col & " row = " & row
  If col <= 0 Or col > 100 Then
    col = ActiveSheet.Range("A3").Column
  End If
  If row <= 0 Or row > 1000 Then
    row = ActiveSheet.Range("A3").row
  End If
  Range("A3", Cells(row, col)).Clear
End Sub


!カラーコードをインデックスで操作。カラーコードは56有ると言う話。
Sub colorAsIndex()
  Dim cell As Range
  Dim row As Integer, col As Integer
  Dim code As Integer
  code = 1
  For row = 0 To 6  ' 行
    For col = 0 To 7  ' 列
      Set cell = Range("A1").Offset(RowOffset:=row, ColumnOffset:=col)
      cell.Interior.colorIndex = code
      code = code + 1
    Next col
  Next row
End Sub

!カラーコードをRGBで操作
Sub colorAsRGB()
  Dim cell As Range
  Dim row As Integer, col As Integer
  Dim red As Integer, green As Integer, blue As Integer
  red = 0
  green = 0
  blue = 0
  For row = 0 To 15  ' 行
    For col = 0 To 15  ' 列
      Set cell = Range("A1").Offset(RowOffset:=row, ColumnOffset:=col)
      cell.Interior.Color = RGB(red, green, blue)
      red = red + 1
      green = green + 1
      blue = blue + 1
    Next col
  Next row
End Sub

!セルの書式指定
RS232Cで送信するAPIはString型しか受け付けないので、セルの文字列を送信しようと言う時にString型ではない値が入っているとエラーとなる。元のエクエルのワークシートで書式指定してもイイのだろうけれど、、、
  ActiveSheet.Range(COM_PORT_INPUT).NumberFormatLocal = "0" ' 数値  "0_"では上手く行かない
  ActiveSheet.Range(TRANSMIT_LINE).NumberFormatLocal = "@" ' 文字列 "G/標準"とすると標準

!RS232Cで日本語が送れる?
エクセルのセルに入力された日本語はおそらくUTF8なのだろうけれど、これをRS232CのAPIの送信関数に与えると上手く行かない。何か方法は有るのだろうけれど、、、

!String型の中身を知りたい
上記にも関係するのだけれど、上手く行かない時に中身を調べる方法
bDataへの代入の直後にデバッカーで止めて変数の中身を確認
    Dim sndData As String
    sndData = ActiveSheet.Range(TRANSMIT_LINE).Value + Chr(CR) + Chr(LF)
  
    Dim bData() As Byte
    bData = sndData

    Dim sndSize As Long
    WriteFile hDev0, sndData, Len(sndData), sndSize, 0

!なんとなくマルチスレッドでRS232Cの受信をしてみたい、、、
とは言えVBA自体にマルチスレッドがサポートされていないらしく、検索すると結構複雑な手順でマルチスレッドっぽい方法を編み出している様だ。せめて受信くらいはなんとかならないのか?

イベントドリブンなVBAでシートに張り付けたボタンに以下のSubプロシージャを登録してみた。
肝はDoEventsと、受信タイムアウト関連のプロパティを設定して、何もデータが無ければすぐに帰ってくる様にしないと。だからと言ってスマートな方法とは思えない、、、
※connectionIsは別のCOMポートのOPEN/CLOSEを行っているボタンの処理の中で書き換える大域変数
' line read from serial.
' return value is recived data bytes.
Function lineRead(ByVal hfile As Long, ByRef line As String) As Long
  Dim loops As Integer
  Dim length As Long
  Dim rcvByteSize As Long
  Dim bData() As Byte
  Dim bString As String
  
  line = ""
  loops = 0
  rcvByteSize = 0
  Do While loops < 100  ' loops is loop limitter.
    bString = String(1, vbNullChar)
    ReadFile hfile, bString, 1, length, ByVal 0  ' read one byte from serial.

    If length = 0 Then  ' if there is no data.
      If rcvByteSize = 0 Then
        lineRead = -1
        Exit Function
      End If
      delay 10
    Else
      loops = 0
      bData = bString
      ReDim Preserve bData(1)
    
      If bData(0) <> CR And bData(0) <> LF Then
        line = line + CStr(Chr(bData(0)))
        rcvByteSize = rcvByteSize + 1
      End If
      
      If bData(0) = LF Then
        Exit Do
      End If
    
    End If
    
    loops = loops + 1
  Loop
  
  If loops < 100 Then
    lineRead = rcvByteSize
  Else
    lineRead = -1
  End If

End Function

Sub dataReadingClick()
  Worksheets("sheet1").Buttons(1).Caption = "受信中"
  
  Dim rcvSize As Long
  Dim line As String
  
  Do While connectionIs = True
    rcvSize = lineRead(hDev0, line)
    
    If rcvSize > 0 Then
      ActiveSheet.Range(RECIEVE_LINE).Value = line
    End If
    
    DoEvents  ' 必ずこれを入れる事
  Loop
  Worksheets("sheet1").Buttons(1).Caption = "受信開始"
End Sub

!オブジェクトのプロパティを知りたい、、、
普通、RADツールであればボタンとかなんとかのプロパティやメソッドは一覧になってIDEから参照できたりするじゃないですか。でもワークシート上に貼り付けたボタンのプロパティをVBEで探しても見付ける事はできなかった。なぜ?そもそもCode Windowに行番号も表示できないし。
例えばボタンのキャプションを変更するのにこんな感じで指定している訳です。
  Worksheets("sheet1").Buttons( 1 ).Caption = "受信開始"

Buttonsの引数に数字を代入しているのです。ボタンの名前とかではなく、、、数字、、、
しょうがないのでWEBを検索してプロパティを調べる方法を見つけました。
Sub buttonListTest()
  Dim Button As Object
  For Each Button In ActiveSheet.Buttons
    Debug.Print "NUMBER =" & Button.Index & " Text = " & Button.Characters.Text & "; Actions = " & Button.OnAction; ""
  Next Button
End Sub

!シート上のボタンを全て削除
上記の応用編です。
Sub clearAllButtons()
  Dim Button As Object
  For Each Button In ActiveSheet.Buttons
    Button.Delete
  Next Button
End Sub

!ボタンを数字でスッキリと扱いたい
Const COM_PORT_OPEN_CLOSE = "E1"
Const COM_PORT_OPEN_CLOSE_WIDTH_HEIGHT = "E1:E2"
Public comPortOpenButtonIndex As Integer ' エクセルを開いたときに実行されるThisWorkbook code window上に、大域変数として番号を収納する変数を用意

起動時実行ハンドラの
Private Sub Workbook_Open()
の中でボタンを生成。この時、先の大域変数にIndexを保存しておく。
  Call clearAllButtons  ' 一旦、存在しているボタンを全て削除
  
  ' 接続ボタンの配置
  With ActiveSheet.Buttons.Add( _
    Range(COM_PORT_OPEN_CLOSE).Left, _
    Range(COM_PORT_OPEN_CLOSE).Top, _
    Range(COM_PORT_OPEN_CLOSE_WIDTH_HEIGHT).Width, _
    Range(COM_PORT_OPEN_CLOSE_WIDTH_HEIGHT).Height)
    .OnAction = "comPortOpenButtonClick"
    .Characters.Text = "接続"
    comPortOpenButtonIndex = .Index
  End With
  Debug.Print "comPortOpenButtonIndex = " & comPortOpenButtonIndex

標準モジュールの参照側は以下の様にIndexにアクセスする。
  ActiveSheet.Buttons(ThisWorkbook.comPortOpenButtonIndex).Caption = "接続中"


以降、順次追加

今読んでいる本

Excel VBAの教科書 (Informatics & IDEA)

Excel VBAの教科書 (Informatics & IDEA)

  • 作者: 古川 順平
  • 出版社/メーカー: SBクリエイティブ
  • 発売日: 2018/07/21
  • メディア: 単行本



気になっている本

パーフェクトExcel VBA (PERFECT SERIES)

パーフェクトExcel VBA (PERFECT SERIES)

  • 作者: 高橋 宣成
  • 出版社/メーカー: 技術評論社
  • 発売日: 2019/11/25
  • メディア: 単行本(ソフトカバー)



nice!(0)  コメント(0) 

EXCEL VBA備忘録 [EXCEL]

リファレンス先として、まずはここ?
https://docs.microsoft.com/ja-jp/office/vba/api/overview/excel

何と言いますか今更ですが、エクセルVBAをやってみたんですよん。

2019-10-29.png意外と使える!と言うかデータ収集してエクセルにダイレクトにシートやセルに代入できるのは、やはり魅力的なので。


勉強してみますか!

参考リンク
VB(Visual Basic)のメモさん
http://www.pursue.ne.jp/Document_doc/doc0009.htm

ExcelVBAプログラミング・メモさん
https://bluefish.orz.hm/sdoc/vba_memo.html

Excel VBA 入門さん
https://www.sejuku.net/blog/category/programing/excel-vba/excel-vba-primer

Excel VBA入門さん
https://www.officepro.jp/excelvba/

Excel VBAでRS-232C通信さん
https://qiita.com/pbjpkas/items/f81947ce38941356ebe4
※64bit OSでやるには、宣言文のDeclareの後ろにPtrSafeを付けなければならない。

RS232C シリアル通信さん
http://www.ys-labo.com/BCB/2007/070512%20RS232C%20zenpan.html
※SetupCommで送受信バッファサイズを変更できる。標準は幾つ?

RS232Cサンプル2(Open,Close,送信,受信の分離). - So-netさん
http://www007.upp.so-net.ne.jp/tmh_ogaw/soft/excel_sample/RS232C_121122_04_.bas
※上記同様

NonSoftさん COMポート(シリアル)で電文の送受信をするサンプル
http://nonsoft.la.coocan.jp/SoftSample/VC/SampleRs232c.html
※ライブラリ化されて物もある

使用できるCOMポートを取得するさん
https://blogs.yahoo.co.jp/sirius_cma1/2519308.html

VBA セルに表示形式を設定するさん
https://www.tipsfound.com/vba/07015

以降、順次追加


なんと言いますか、シリアルデータをESP32でGoogle Spread sheetに飛ばした方が、現代的かなぁ、、、
http://www.telomere0101.site/archives/post-1008.html

今読んでいる本

Excel VBAの教科書 (Informatics & IDEA)

Excel VBAの教科書 (Informatics & IDEA)

  • 作者: 古川 順平
  • 出版社/メーカー: SBクリエイティブ
  • 発売日: 2018/07/21
  • メディア: 単行本



気になっている本

パーフェクトExcel VBA (PERFECT SERIES)

パーフェクトExcel VBA (PERFECT SERIES)

  • 作者: 高橋 宣成
  • 出版社/メーカー: 技術評論社
  • 発売日: 2019/11/25
  • メディア: 単行本(ソフトカバー)



nice!(0)  コメント(0) 

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。