ExcelVBAプログラミング・メモ
by K.I
2012/04/01〜
Index
- ExcelVBAは、ちょっとしたインターフェースを作るのに便利。
- やろうと思えば、けっこう複雑なことをさせることも出来る。
- ネットワーク上の情報も非常に多い。
- MicrosoftExcelは必要だけど、入ってる環境も少なくはないので、
- 自分用に、いろいろ基本的な使い方、Tipsをメモしたもの。
- ほとんどは自分で考えたわけじゃなく、ネット上の情報の受け売りや、リンク先のコードをそのまま転載したものが多い。
- いろいろな情報を公開されているリンク先の方々に感謝です。
- ちなみに、これを試したExcelのバージョンは、2003SP3
[top]
接尾辞 | 型宣言 | 名称 | サイズ | 値の範囲 |
$ | String | 文字型 | 2/文字 | 文字列の長さは 0〜32K |
なし | Byte | バイト型 | 1 | 0〜255 |
% | Integer | 整数型 | 2 | ‐32,768〜32,767 |
& | Long | 長整数型 | 4 | ‐2,147,483,648〜2,147,483,647 |
@ | Currency | 通貨型 | 8 | ‐922,337,203,685,477.5807〜922,337,203,685,477.5807 |
! | Single | 単精度浮動小数点数型 | 4 | ‐3.402823E+38〜3.402823E+38 |
# | Double | 倍精度浮動小数点数型 | 8 | ‐1.7976931348623158+308〜1.7976931348623158+308 |
なし | Boolean | 論理型 | 2 | True(‐1), False(0) |
- これはノーツの話らしいので、全部VBAと対応しているかは未確認。
- VBAの、Select Case文は、けっこう使いやすい。
- という感じで、範囲で判定出来る。
- Splitを使って、空白区切りの文字列を配列にする例
Dim result As Variant
result = Split(str_data," ")
- 配列のデータを、WorkSheetに入れる関数を作ってみる
- 前項の様に作成した、Variant配列に入れたデータを渡す
show_result(result)
- 配列をWorksheetに入れる関数の例
Sub show_result(result As Variant)
Dim i As Integer
Dim x As Integer, y As Integer
x = 3
y = 10
For i = 1 To UBound(result)
With Worksheets("Result")
.Cells(y, x) = Val("&h" & result(i))
End With
y = y + 1
Next i
End Sub
- UBoundで、配列の数分だけ繰返す
- この例では、データが16進文字列で、16進→10進変換してから書込んでいる。
- ワークシートの場合は、 Workbook_openに記述する
Private Sub Workbook_open()
'起動時の処理
End Sub
- UserFormの場合は、 UserForm_Initialize
Private Sub UserForm_Initialize()
'起動時の処理
End Sub
- ワークシートの場合は、 Workbook_BeforeCloseに記述
- UserFormの場合は、 UserForm_QueryCloseで記述する
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'終了処理
Cancel=False
End Sub
- CloseModeは、 どのように閉じられたかを示す
定数 | 値 | 意味 |
vbFormControlMenu | 0 | クローズボタン(×ボタン)が押された |
vbFormCode | 1 | コードによるUnload命令 |
vbAppWindows | 2 | Windowsの終了 |
vbAppTaskManager | 3 | TaskManagerによる終了 |
vbFormMDIForm | 4 | MDIFormの上位が終了 |
[top]
- Excel本来のスプレッドシートの処理方法に関するメモ
- ワークシートの大きさは、行全体を表すRowsと、列全体を表すColumnsを使えば、以下のようになる
SizeRow = Rows.Count
SizeColmn = Columns.Count
- 上記の方法では、ワークシートの大きさは分かるが、データの範囲は分からない。
- それぞれ後ろの方から、1列目の最終データの行、1行目の最終データの列を探している
- xlUpは上方向に探す、xlToLeftは左方向に向かって探すという意味
- データの最初から、連続したデータの最後の位置を求める場合は、以下のようにする
MaxRow = Cells(1,1).End(xlDown).Row
MaxColumn = Cells(1,1).end(xlToRight).Column
- この例では、最初から連続したデータの最後を探している
- xlDownは下方向に探す、xlToRightは右方向に向かって探すことになる
Cells.Clear
Range("C10:X100").Clear
Range("C10:X100").ClearContents
- グラフの範囲を指定する
- A1:A100の範囲を指定する例。シート名を必ず指定する必要がある
ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Formula = _
"=SERIES(,,sheet_name!$A$1:$A$100,1)"
- 描画されたグラフの範囲を知りたい場合は、グラフのデータをクリックすると、
ChartObjects(1).Chart.SetSourceData Source:=Range("C10:C4115")
[top]
- 要するに、Excelのシートとは別のWindowを作ることが出来る。
- Excel上にボタンを付けても全く問題ないんだけど、Windowがあるとアプリっぽい。
- Alt-F11で、Microsoft Visual BasicのWindowを出して、
- プロジェクト・ウィンドウのフォームに、UserForm1が出来る
- ダブルクリックすると、空のウィンドウが表示される。
- 右クリック→コードの表示で、プログラムを記述するウィンドウが表示される
- プロパティウィンドウで、オブジェクト名や、Captionを変更することも可能
- UserForm.Showで表示できるけど、これだとフォームしか操作できない
- これでフォーム操作と同時に、Excelのシートのデータを入力することが出来る。
- コンボボックスというのは、テキストボックスの横の▼をクリックすると、
- リストが表示され、選択すると、テキストボックスに入力されるというもの。
- ツールボックスのコントロールで、コンボボックスのアイコンを選択、
- フォーム上で、ドラッグして大きさを決めると、コンボボックスが配置される。
- プロパティウィンドウで、コンボボックスのオブジェクト名を変更しておく。
- コンボボックスは複数あると分らなくなるので、例えば、MyListと名前を変えておく。
- 選択されたコンボボックスのインデックス番号は、
- ListIndexプロパティで取得することが出来る。
- ユーザーフォームを右クリック→コードの表示で、コードウィンドウを出して、
- その上にある左側のコンボボックスから、MyListを選択
- 右側のコンボボックスから、イベントを選択する
- 選択する度に、関数の雛形というか、空っぽの関数が出来る。
- でも、コンボボックスには、Initialize(初期化)が無いみたいなので、
- 生成された空の関数名を、MyList_Initializeにする。
- それから、使わない空の関数が出来た場合は消しておく。
Private Sub reg_rw_Initialize()
With reg_rw
.Style = fmStyleDropDownCombo
.Clear
.AddItem ("ABC")
.AddItem ("DEF")
.AddItem ("GHI")
.AddItem ("JKL")
.ListIndex = 1
End With
End Sub
MyList_Initialize関数は出来たけど、これはイベントでは実行されない。
- ユーザーフォームを右クリック→コードの表示で、コードウィンドウを出して、
- 今度は、その上にある左側のコンボボックスから、UserFormを選択
- 右側のコンボボックスに、Initializeがあるので、選択
- UserForm_Initializeで、MyList_Initializeを実行すれば、
- またツールボックスのタブで、新しいページを作って、
- グループ化した設定項目等のパターンを幾つか登録しておくと、使いまわし1が出来て便利
- オプションボタン等は、フレーム内に入れることで同一グループとなる。
- でも、これはプロパティで、GroupNameを同じに設定することと同じこと。
- 良く似ているけど、使い方は全然違う
- マルチページは、全く違うコントロールを配置できる
- タブストリップは、同じコントロールが表示されるが、値は別々に保持する
- といっても、タブストリップは自動的に値を別々に保持できるわけじゃないので、
- プログラムで、TabStrip.SelectedItem.Captionを確認して、自分で別々に保存しておかなければならない。
- 或は、値は変化しないけど、モードを変化させるような使い方でも良いと思う
- ちなみに、マルチページやタブストリップの選択されたインデックス番号は、
- なんとかindexとかじゃなくて、valueプロパティに設定される。
- これは、フォームに追加することは出来ないようだ。
- とりあえず、テキストボックスをフォームの下に貼り付けて、
- BackColorをメニューバーの色とかに設定して、誤魔化すぐらいしかないかな。。
- Excel本体の方は、Application.StatusBarに入れれば表示される。
- 最後に、Falseを入れて、Excelが使えるようにする必要がある。
- で、出来ないと思ったんだけど、ツールボックスを右クリック→その他のコントロールを選択
- Microsoft StatusBar Control 6.0 (SP2)をチェックしてOKとすると
- ステータスバーコントロールが追加される
- 最初、どうやって設定するか解らなかったけど、プロパティのプロパティページで設定できるみたい。
StatusBar1.Panels.Item(1).Text = "ABC"
- vbCRLFが、Pの逆みたいなへんな文字で表示される
- MultiLineプロパティを、trueにすると、ちゃんと改行された。
- 改行文字を取ってしまう時は、以下のようにする
- CRLFか、CR、LF単独も有り得るので、個別に削除する
txt.value = Replace(Replace(txt.value, vbCr, ""), vbLf, "")
1新規のフォームを作る時も、登録した部品が使える。
[top]
- VBAのソースを修正していると、書きかけの時にも、いちいち構文エラーのダイアログが出てきて、かなりウザイ。
- こんな時は、ツール→設定→編集タブ→コードの設定で、自動構文チェックを外す。
- これでダイアログは出なくなる。
- エラー箇所は赤くなるので、普通は、これで十分のような気がする。
- 何かの拍子に、プロジェクトエクスプローラが消えてしまって、
- 表示→プロジェクトエクスプローラで、再表示したが、左側に表示してくれない。
- 結局、ツール→オプション→ドッキングタブで、
- プロジェクトエクスプローラが選択されていなかったのが原因らしい。
- マクロで自動実行させる際に、マクロを有効にするダイアログが邪魔でうまく動作しない場合がある。
- とりあえずは、ツール→オプション→セキュリティタブで、マクロセキュリティのレベルを低に設定すれば良い。
- もう一つの方法として、デジタル署名を発行して、
- 最初の起動時に、一度だけ確認すれば、それ以降はダイアログが出なくなる。
- すべてのプログラムから、MicrosoftOfficeのMicrosoftOfficeツールのVBAプロジェクトのデジタル署名を選んで、
- デジタル証明書の作成で、証明書の名前を指定して、証明書を作る。→証明書の名前は誰が作ったか明確に分かるものにした方が良い
- でも、これは証明機関を通して作った正式の証明書じゃないので、当然、証明書自体は何も保障するものではない
- あとは、Excelファイルで、Alt-F11キーを押してVisualBasicEditorを開いて、
- ツール→デジタル署名で、作成した証明書で署名すれば良い。
- 作成者が明確で、安全なファイルであれば、この方法で署名しておけば、最初の起動時の確認だけで済む
- 但し、デジタル署名は、マクロを変更すると解除されてしまう。
- 逆に、改変されているかどうかを簡易的にチェックすることが出来るようだ。
- Excel2003以前のバージョンでは、1〜56のカラーパレットの色しか使えない。
- 最新のExcelでは、自由に色設定できるようになったみたいだけど、まだまだ古いExcelも現役なので、その機能は使えない。
Sub ShowColorPalette()
Dim x As Long
Dim y As Long
For x = 1 To 8
For y = 1 To 7
With Cells(y, x)
.Interior.ColorIndex = (y - 1) * 8 + x
.Value = (y - 1) * 8 + x
End With
Next
Next
End Sub
- RGBで色設定できるけど、 結局はパレットでの近い色に設定されてしまうだけだ。
Cells(y,x).Interior.Color = RGB(r, g, b)
- パレット番号を指定して、 パレットの色設定をRGB設定で変更することは出来る。
- Excel11.xlbというファイルに設定が残る様なので、それを消せば多分元に戻る。
- でも、色以外の設定も入っているので、それらの設定も一緒に消えてしまう。
- 以下のコマンドで、パレットの色設定をリセット出来る様だ。
ActiveWorkbook.ResetColors
- 最新の Excelと、Excel2003以前のものは、カラーパレットの互換性がないらしい。
- Excel97とExcel2003しか使ったことが無いけど、混ぜて使ったらどうなるんだろう?
[top]
Public Drg As Boolean 'Drag flag
Public DrX As Single, DrY As Single 'Drag location
Button1の処理をFormに記述
Private Sub Button1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Drg = False Then
Drg = True
DrX = X: DrY = Y
Button1.ZOrder 0
End If
End Sub
Private Sub Button1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim XX As Single, YY As Single
If Drg Then
XX = Button1.Left + X - DrX
YY = Button1.Top + Y - DrY
Button1.Move XX, YY
End If
End Sub
Private Sub Button1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Drg = False
End Sub
ちょっと変わったインターフェースにしたい時に使えるかも。
- ちなみにButtonには、マウスの押したボタンが入る。
- bit0は右、bit1は左、そしてbit2は真中のクリックということらしい。
- senderがあれば、使いまわせる2んだけどなぁ。。
- っていうか使いまわせないので、全部のオブジェクトに、3つ同じプログラムを書く必要がある。
- ひょっとすると、新しいバージョンのExcelなら出来るのかなぁ。。。
- ブラウザのように、ハイパーリンクするTEXTを作る
- まず、ラベルを作って、青色に設定、それから下線を付けておく
- これで、ハイパーリンクするテキストが出来たが、
- リンク箇所に持っていくとカーソルが変わったほうが、それらしい。
- カーソルの変更は、ラベルのプロパティで、
- MousePointerを、99 - fmMousePointerCustom に設定
- MouseIconに、ico,curファイルを設定
- カーソルファイルは、C:\windows/cursorsにあるが、おなじみの指アイコンが見当たらない
- アイコンエディタとかあるので、それで作っても良いし
- アイコンを、bmpとかgifで作って、Gimpとか使って、icoファイルに変換しても良い
- 別のアプリケーションを起動して、ファイルをOpenする。
- ShellExecuteのAPIを定義して、
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
- この例ではHTMLファイルを開いているが、アプリケーションは特に指定しないので、
- デフォルトのアプリケーション、例えばInternetExprolerが起動する。
Dim file As String
file = ThisWorkbook.Path & "\test.html"
ShellExecute 0, "open", file, vbNullString, vbNullString, SW_SHOWNORMAL
- ExcelVBAは、Excelのスクリプトなので、フォームアプリケーションを作っても、
- Excelのシートが、表示されたままなので、なんかアプリっぽくない。
- それで、Excelのシートを消してしまえば良い。
- これは、Application.Visibleを、Falseにすれば良いだけだと思っていた。
- でも、 このページを見て、それだけじゃダメと分った。
- フォームを表示する時に、モードレスウィンドウにしておいた方が良いらしい。
- 問題は、Excelを非表示にしたまま、フォームを閉じると、Excelのプロセスが残ったままになってしまうということ。
- フォームを閉じた時に、Excelを閉じるスクリプトを
- なるほど、フォームを閉じる時に、アプリケーションを終了すれば良いのか。。
- 後から、他のExcelBookを開くと、非表示にしていたフォームアプリのシートも見えてしまう。
- これは、フォームのBookを表示状態にしておいて、ウィンドウメニュー→表示しないを選択して保存するだけで良いらしい
- つまり、Excel自体が表示されても、シートが表示されなければ良いということ。
- でも、他のExcelBookを開いた状態で、フォームアプリを開くと、
- つまり他のExcelが開いている場合は、Excelを非表示にしてはいけない。
- そして終了時に他のExcelが開いている場合は、Excelを終了せずに、フォームのBookのみ閉じる
- 起動時の処理
- 但し、UserForm内でWorkBook内のデータをアクセスするようになっていると、
- Load時にエラーになるようだ。WorkBookに前回のデータを保存する等は出来ないのかな?
- フォームアプリに関する記述は、 なっくるすきるすさんの情報そのままです。
- なくなると困るので備忘録として載せましたが、なっくるすきるすさんの説明はとても解りやすいので、是非そちらを参照下さい。
- 前述の、Excelのシートを消す方法で消したウィンドウを再表示する方法が、よく分らない。
- 再表示の場合は、以下のようにファイル名を指定するしか無いように思える
Windows("filename.xls").Visible = True
マクロを作って実行するのも面倒だし。
- 仕方がないので、普通のWorkBookを同時に開いて、
- ウィンドウ→再表示で、表示させることで逃げている。
Public Function csv(ParamArray args() As Variant)
Dim argcsv As String
For Each arg In args
If argcsv <> "" Then
argcsv = argcsv & ","
End If
If IsNumeric(arg) = False Then
argcsv = argcsv & """" & arg & """"
Else
argcsv = argcsv & arg
End If
Next
csv = argcsv
End Function
ParamArrayって、普通の配列と何が違うんだろう。
- そうか。引数としてバラバラに指定出来るってことか。。
- これはテクニックでは無いけど、基本の話
- 戻り値を使う場合は、括弧を付けなくてはならない
- 戻り値を使わないものは、括弧を付けてはいけない
- 戻り値を使わないものは、括弧を付けなくて良いではなく
- 戻り値を使わない場合、括弧を付けると引数の括弧ではなく、演算としての括弧になってしまうらしい。
- 引数が1つの場合はエラーにはならず、普通は結果も同じになるが、間違った使い方なので、正しく動作しない可能性もある。
- どうしても括弧を付けたい場合は、Callで呼び出せば良い。
- マクロを起動したパスは、ThisWorkbook.Pathで求められる。
- ThisWorkbook.Pathから、いつも絶対指定した方が、むしろ簡単かもしれない。
- Workbooks.Addで、新規WorkBookを作ることが出来る。
- でも、保存するまでWorkBook名を付けることが出来ない(勝手に付けられる)
- それで、SaveAsでとりあえず保存してWorkBook名を確定させるようにしてみた。
Private Function CreateDataBook(filename As String) As String
ChangeCurPath 'カレントパスを戻す(念のため)
Workbooks.Add "data_templete.xlt" 'データ出力用WorkBookをコピーして新規作成
ActiveWorkbook.SaveAs filename 'ファイル名設定して保存
CreateDataBook = ActiveWorkbook.Name 'データ出力用WorkBook名を返す
End Function
引数のWorkBook名と、戻り値は同じになるはず。
- OnTimeを使うと、指定時刻になったら指定したプログラムを実行できる。
Application.OnTime TimeValue("12:34:56"), "ProcName"
Application.OnTime Now + TimeValue("00:05:00"), "ProcName"
- 待っている間、他のことをやっていても良いので、いろいろ使い道がありそう。
- 実行されるプログラムは、標準モジュールに入れておくこと。
- インターバルタイマ処理も欲しいところだけど、これはAPIで記述するしかなさそうだ。
- 但し、これはマルチスレッドなので難易度は高くなる。お手軽にExcelのVBAで記述する範疇では無い様な気がする。
- 長い処理をしていると、処理が終わるまで画面が全く変化しなくて、
- ちょっと不安になったりするので、適当に画面表示を更新する。
Me.Repaint
- 処理をシステムに一旦返すということでは、以下のようにしても良い。
DoEvents
- フォームは最前面に表示されるので、Excelのシートを編集する場合に邪魔になる。
- こちらに、最小化・最大化ボタンを付けるやり方が紹介されている。
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long
Public Const GWL_STYLE = (-16) 'ウィンドウスタイルを取得
Public Const WS_MINIMIZEBOX = &H20000 '最小化ボタン
Public Const WS_MAXIMIZEBOX = &H10000 '最大化ボタン
あとは、ExcelのフォームWindowのハンドルを取得して、ボタンを追加すれば良い。
Dim fRet As Long
Dim hWnd As Long
Dim fStyle As Long
Load UserForm1
UserForm1.Show vbModeless 'ユーザーフォーム表示
hWnd = FindWindow("ThunderDFrame", UserForm1.Caption) 'ハンドルを取得
fStyle = GetWindowLong(hWnd, GWL_STYLE) 'ウィンドウ情報を取得
fStyle = fStyle Or WS_MINIMIZEBOX '最小化ボタン追加
fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) '追加したボタンを設定
fRet = DrawMenuBar(hWnd) 'メニューバーを再描画
FindWindowの1つ目の引数、"ThunderDFrame"はExcelで使用しているWindowクラス名、
- 2つめの引数はWindowのCaptionなので注意!
最大化ボタンが必要な場合3は、WS_MAXIMIZEBOXを付ければ良いが、
- 付けなくても無効状態ではあるものの、表示はされてしまう。
- 複数のユーザーフォームの表示順入替えの方法は、 こちらで紹介されていた。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Dim hWnd1 As Long, hWnd2 As Long, hWnd3 As Long
Private Sub UserForm_Initialize()
'ユーザーフォームのハンドルを取得する(注)第二引数はユーザーフォームのCaption
hWnd1 = FindWindow("ThunderDFrame", UserForm1.Caption)
hWnd2 = FindWindow("ThunderDFrame", UserForm2.Caption)
hWnd3 = FindWindow("ThunderDFrame", UserForm3.Caption)
End Sub
Private Sub CommandButton1_Click()
SetForegroundWindow hWnd1
End Sub
Private Sub CommandButton2_Click()
SetForegroundWindow hWnd2
End Sub
Private Sub CommandButton3_Click()
SetForegroundWindow hWnd3
End Sub
- 複数のコントロールに、同様の設定をする場合、 VBAではコントロール配列が無いので面倒。
- 複数のコントロールのイベントを纏める
- というような事は出来ないと思っていたが、 こちらでクラスを使ったやり方が紹介されていた。
- 内容は、そのまんまです。要約すると、
- 例えば、Btn0〜 Btn9というボタンがあったとして、
- このボタンを押すと、 TextBox1に数字が表示されるようにする。
- まず、ボタンのクラスを作る(例えば BtnClassとする)
- メソッドとして、以下を記述4
- ボタンを登録するための、 NewClass →コンストラクタ的なもの
- TextBox1に数字を表示する、 Btn_Click →Clickイベントルーチン
Private WithEvents Btn As MSForms.CommandButton
Private Index As Integer
Public Sub NewClass( ByVal c As MSForms.CommandButton, ByVal i As Integer)
Set Btn = c
Index = i
End Sub
Private Sub Btn_Click()
UserForm1.TextBox1.Text = Index
End Sub
- これで、ボタンコントロール Btn0〜9に対して、クラスが割当てられたので、
- ボタンをクリックすることで、 共通のBtn_Clickルーチンが実行される(らしい)
- なるほど〜こんな方法があるのか。 これは使いこなせば、いろいろ応用が出来そうだ。
- メモしただけで未確認なので、後で確認してみよう。。
- 確認しました。 ちゃんと動作します。(Excel2003で確認)
2イベントプロシジャーを切換えられるようになってないとダメだけど。
3Excel/VBAのフォームでは、そもそも最大化ボタンが必要な場合が少ない気がする。
[top]
- 制御に欠かせない、シリアルインターフェースのコントロールに関すること
- ExcelVBA自体には、COMポートを操作するためのインターフェースが無いので、
- activecellから提供されている EasyCommという、フリーのモジュールを使用する。
- 残念ながら、ActiveCellでの提供は止めてしまった様4です。(130820追記)
- 現状、公式にはダウンロード出来なくなってしまっています。とても有用なプログラムなので残念です。(130911追記)
- EasyCommをダウンロード、ec184.lzhを展開すると、ec.bas,ecDef.basというファイルが入っている
- ExcelVBAの、ファイルメニュー→ファイルのインポートで、2つのbasファイル(モジュール)を読み込む
- EasyCommを使ったコマンド送信の例
- CRLFをデリミタにした応答があることを前提にしている
Function SendCmd(ByVal port As Long, ByVal cmd As String) As String
ec.COMn = port ' ポート設定
ec.Setting = "9600,n,8,1" ' 通信条件設定
ec.HandShaking = ec.HANDSHAKEs.No ' ハンドシェークなし.
ec.Delimiter = ec.DELIMs.CrLf ' デリミタ設定
ec.AsciiLine = cmd ' コマンド実行
SendCmd = ec.AsciiLine
ec.COMn = -1 ' ポートを閉じる
End Function
- コマンドに対する応答が、関数の戻り値になっている。
Function SendCmd2(ByVal port As Long, ByVal cmd As String) As String
On Error GoTo ErrHandle
ec.Xerror = 1
ec.COMn = port ' ポート設定
ec.Setting = "9600,n,8,1" ' 通信条件設定
ec.HandShaking = ec.HANDSHAKEs.No ' ハンドシェークなし.
ec.Delimiter = ec.DELIMs.CrLf ' デリミタ設定
ec.AsciiLine = cmd ' コマンド実行
SendCmd2 = ec.AsciiLine
ec.COMn = -1 ' ポートを閉じる
Exit Function
ErrHandle:
MsgBox "Com" & port & " が使用できません。" & vbCrLf & "COMポート番号、或は接続を確認して下さい。"
End Function
- データ量が多く、且つ転送速度が速い場合は、取りこぼす可能性があるので、
- この例では、Integerだと32767までなので、&を付けてLongにしている。
- 応答が無い場合に、ずっと待ち状態になってしまうので、
- この時間だけ待って、応答がなければ次の処理を実行する。
- バイナリで4byte受信したら、2byteづつ10進に直して、カンマ区切りで戻すルーチン
- activecellで紹介されていた方法を、ちょっと弄っただけ。
Public Function SendCmdB(ByVal port As Long, rate As Variant, ByVal cmd As String) As String
Dim StartTime As Date ' 処理開始時刻
Dim bindata() As Byte ' データ列
ec.COMn = port ' ポート設定
ec.Setting = rate & ",n,8,1" ' 通信条件設定
ec.HandShaking = ec.HANDSHAKEs.No ' ハンドシェークなし.
ec.Delimiter = ec.DELIMs.CR ' デリミタ設定
ec.InBufferClear ' 受信バッファクリア
ec.AsciiLine = cmd ' コマンド実行
StartTime = Now ' 開始時刻の記憶
ec.BinaryBytes = 4 ' 受信バッファから4バイトを取得
Do
If Now > StartTime + TimeSerial(0, 0, 1) Then Exit Function ' タイムアウト 1sec
DoEvents
If ec.InBuffer >= 4 Then ' 4バイト以上受信
DoEvents
bindata() = ec.Binary ' 取得
Exit Do
End If
Loop
SendCmdB = Str(bindata(0) * 256& + bindata(1)) & "," & Str(bindata(2) * 256& + bindata(3))
ec.COMn = -1 ' ポートを閉じる
End Function
- この例では、Time関数でタイムアウトを判断しているが、
- バイナリ受信の時は、AsciiLineTimeOutが効かないのかもしれない。
- EasyCommは、基本的に割込み処理できない5みたいなので、ポーリングでデータを監視する必要がある。
- ActiveCellのサイトに、 ecFoxというサンプルがあるので参考になる。
- 真似して、受信用ボタンを自分なりに作ってみた。
- Startすると、Captionを書換えてStopボタンになるようにしている。
- 受信データは空白区切りで、最後にCRが付いていることが前提。
Private Sub BtnRun_Click()
Dim bin() As Byte
Dim data As String
Dim result As Variant
If RunFlag Then ' Stopボタン処理
RunFlag = False
BtnRun.Caption = "Start"
Else ' Startボタン処理
ec.COMn = 10 ' COMポート番号
ec.Setting = "9600,n,8,1" ' 通信条件設定
ec.HandShaking = ec.HANDSHAKEs.No ' ハンドシェークなし.
ec.BinaryBytes = 1 ' 取得バイト数を設定
RunFlag = True
BtnRun.Caption = "Stop"
Do While RunFlag ' Stopされるまで繰返す
data = ""
Do While RunFlag
DoEvents ' これが無いと他の処理が出来ない
If ec.InBuffer > 0 Then
bin() = ec.Binary
If bin(0) = &HD Then ' CRまで続けて読む
Exit Do
Else
data = data & Chr(bin(0))
End If
End If
Loop
result = Split(data, " ") ' 空白区切りで配列に変換
show_result result ' データを処理
Loop
ec.COMn = -1 ' ポートを閉じる
End If
End Sub
- RunFlagは、標準モジュールとかで予め定義しておく。
- COMポート一覧を取得する方法が無いか探していたら、
- CRLF区切りの文字列として、シリアルポートのリストが得られる。
4やはり、サポートは大変な様です。今更ですが、これまでのご尽力に感謝します。
5Excel/VBA自体がそうなのかな。
[top]
- Excel/VBAのクラスモジュールのメモ
- メンバ関数とメンバ変数を、 それぞれメソッドとプロパティと呼ぶらしい。
- VBE(Visual Basic Editor)の挿入メニューからクラスモジュールを選択
- オブジェクト名がクラス名になるので、 機能を表す名称を付ける
- とりあえず、TestClassという名前を付けたとする。
Public Sub Clear()
m_name = ""
End Sub
- クラスを呼出す場合は、インスタンスを作成する必要がある。
Dim Name1 As TestClass
Dim Name2 As TestClass
Set Name1 = New TestClass
Set Name2 = New TestClass
Name1.name = "ABC"
Name2.name = "DEF"
Print Name1.name
Print Name2.name
Call Name1.Clear
Call Name2.Clear
[top]
- VBA用のDLLを作る
- こちらを参考にしました。というか、ほとんどそのままです。
- 分かりやすく解説してあるので必要ないけど、無くなったら困るのでメモ。
- VB5でやってみました。
- まず新規作成で、Win32のDynamic Link Libraryを作成
- ヘッダファイルを2つ作成する。
- DLL内部で使用するものと、外部とのインターフェース用
- VBAの、long, double, stringは、それぞれCの int, double, char* で受けることが出来た。
- ここら辺は、まだ良く分かっていない処もあるので参考程度
- 条件コンパイルで、ヘッダを一つにすることもできるらしい。
- というか、前にそんなヘッダを見たことがあるような気が6する。
- DLLMainは、Trueを返すだけで良いらしい。
- funcnameDLL.cpp
#include <windows.h>
#include <stdio.h>
#include <stdlib.h>
BOOL WINAPI DllMain(HINSTANCE hinstDLL, DWORD fdwReason, LPVOID opvReserved)
{
switch(fdwReason){
case DLL_PROCESS_ATTACH: // ロード
case DLL_PROCESS_DETACH: // アンロード
case DLL_THREAD_ATTACH: // 新規スレッド生成
case DLL_THREAD_DETACH: // スレッド終了
break;
}
return true;
}
__declspec(dllexport)int WINAPI funcnameDLL(int pt, double th, char *file)
{
return pt+th*1000;
}
- VBA用のDLL関数には、やはりWINAPIが必要らしい。
- VC5では、新規作成でdefファイルというのは無いので、テキストファイルとして作成する
- 前述のヘッダの場合は、例えば、こんな感じで呼び出すことが出来る
Declare Function funcname Lib "funcname.dll" Alias "funcnameDLL" _
(ByVal tmp1 As Long, ByVal tmp2 As Double, ByVal tmp3 As String) As Long
Function dlltest() As Long
Dim a As Long
Dim b As Double
Dim d As String
a = 500
b = 0.123
d = "newbuf"
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
dlltest = funcname(a, b, d)
End Function
- Declareで、関数のインターフェースを記述する
- Function名とAlias名を同じにすることは出来ない様7だ
- StringをByValで渡しているが、何故か値を返すことが出来る8みたい。
- 但し、元の文字列の長さを超える大きさにしない様に注意する必要がある。
- 或いは、NULLを詰め込んで大きめの文字列にして渡すと良いらしい。
6DLLは、たまにしか書かないので、すぐ忘れる。。
7なので、Cの関数名にDLLを付けて、VBA側の関数名はDLLを付けないようにしてみた。
8試しにやってみたら出来たけど、何故だろう?
[top]
- Show UserFormのvbModelessが出来ないので、 モーダルでしかフォームを表示できない
- 未解決
- 結局、これはうまく行かないので、vbModeless指定を外して、UserForm表示時はシートの編集は諦めた
Function replace(data As Variant, fromstr As Variant, tostr As Variant) As Variant
replace = Application.Substitute(data, fromstr, tostr)
End Function
Function split(line As Variant, sepa As Variant) As Variant
Dim list() As Variant
Dim spos, epos As Integer
Dim n As Integer
n = 0
spos = 1
While (spos <= Len(line))
epos = InStr(spos, line, sepa)
If (epos = 0) Then epos = Len(line) + 1
spos = epos + 1
n = n + 1
Wend
spos = 1
ReDim list(n)
n = 0
While (spos <= Len(line))
epos = InStr(spos, line, sepa)
If (epos = 0) Then epos = Len(line) + 1
list(n) = (Mid(line, spos, epos - spos))
spos = epos + 1
n = n + 1
Wend
split = list
End Function
- Split関数は、結果を配列で返すようになっているので、そうした。
- VBAの配列の扱いがイマイチ分ってないので、自信なし。
- 自分のプログラムでは、とりあえず動くようになったが、
- 条件によっては、うまく動かないかもしれない。 要注意!
[top]
- Load Userform1を実行したら、 以下のエラー
実行時エラー'9':
インデックスが有効範囲にありません
- これは、UserForm1のコード中で、セルとか配列の範囲外の場合に出るんだけど、
- 普通の変数名が間違っていたり、無かったりした時にも出る。
- UserForm1のコードを全部見直すこと。
- 単純に、変数が見つかりませんと言ってくれた方が分り易いんだけど。。 。
- Windows7のマシンで動かすと、以下のDialogが出て動かない
- こんな風に言われても困るんだけど。。。
オートメーションエラー
エラーを特定できません
- こちら を参考にして、コマンドプロンプトで、以下のコマンド実行(管理者権限で)
regsvr32 mscomctl.ocx
- これで治った。良く分からないが、OCXを再登録しているらしい。
- GetSaveAsFilenameを使おうと思ったんだけど、
Dim FileNam As Variant
FileNam = Application.GetSaveAsFilename( _
InitialFileName:="undef.csv", _
FileFilter:="CSV file(.csv),*.csv", _
Title:="CSVファイルの保存")
実行時エラー '1004':
'GetSaveAsFilename'メソッドは失敗しました:'_Application'オブジェクト
- 何故だ?
- いろいろ試していたら、Filefilterの中の括弧を全角にしたら治った
FileNam = Application.GetSaveAsFilename( _
InitialFileName:="undef.csv", _
FileFilter:="CSV file(.csv),*.csv", _
Title:="CSVファイルの保存")
- ちょっと納得しがたい。むしろ全角の方が気持ちが悪いんだけど。
- 半角に戻すと、やはりエラーになるので仕方がない。。。
- DLLをExcelファイルと同じディレクトリに入れて実行してみたが、以下のエラー
実行時エラー'53':
ファイルが見つかりません: xxxx.dll
普通のプログラムだと、DLLファイルは実行プログラムと同じディレクトリに入れておけば良い9んだけど、
- VBAの場合は、Excelで設定されているカレントフォルダに無いとダメらしい。 →参考
- ということで、以下のようにBOOKのあるディレクトリに設定してから実行すれば大丈夫だった。
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
- Excelで、フォームを表示するマクロを実行すると、
システムエラーです : &8000FFFF(-214748113) 致命的なエラーです
さらに
メモリが不足しています
- FormのLoadぐらいしかしてないので、多分初期化ルーチンだと思うんだけど、原因不明
- あるPC(XP,Excel2007)だけで発生する問題なので、とりあえず保留。
9system32とかに置けば良いのかもしれないけど、VBAプログラムを配布する時に、そんな場所に置いてもらうのは実質上出来ないよね。
[top]
[top]
[プログラムの部屋に戻る]