【VBA】Twitter お題「ねこちゃんの数を数える」を解いてみた
Twitter で、ほえほえ氏から提示されたお題「ねこちゃんの数を数える」を解いてみた。
少しお題を考えたので投稿してみます。お題のためのお題ということで少し不自然だし、簡単な解法があるかもしれませんがご容赦を。発展型で言ってみます。
— ほえほえ＠LWP (@hoehoe1234) 2020年2月23日
お題 ねこちゃんの数を数える
です。（つづく）
ざっくり言えば、「親猫」、「子猫」、「猫又」・・・といった文字が並んでいて、
それぞれ何匹いるのかを数えるというもの。
take 1からtake 7まであって、
それぞれに条件がついています。
| Take | 条件 | 文字列 |
|---|---|---|
| 1 | 親猫と子猫を数えて（数と種類を報告）ください。 | 親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫 |
| 2 | 簡潔に書くために同じ種類の猫が連続する場合は「猫」一文字で代用することにしました。 「親猫猫子猫猫」は、親猫が２匹、子猫が２匹です。 |
親猫猫猫子猫猫猫猫猫猫親猫子猫猫 |
| 3 | せっかく簡潔に書く記法を開発したのに適当に書くやつが現れました。そのせいで繰り返しの代わりに元の記法もOKになりました。 親猫が３匹の場合下のいづれもOKとします。 親猫親猫親猫 親猫猫親猫 親猫猫猫 |
子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫 |
| 4 | なんと列に「猫又」が混じってしまいました。親猫、子猫、猫又の数を数えてください。 | 子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫 |
| 5 | いままでは親猫子猫猫又でしたがいろいろな種類の猫がが混じってしまいました。 ただし猫の名前は２文字で最後に「猫」がつくのは同じです。 例で白猫黒猫がいますが実際はもっとたくさんの種類がいます。（青猫、緑猫とか） |
子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫 |
| 6 | なんと不条理な上司！登場。あろうことか、「猫又が二匹現れたらその時点で猫の種類と数を報告して作業を終了せよ」といわれました。どうしよう。。。 上司によると猫又２匹とは「累計して２匹」現れたらとのことで、連続２匹ということではない模様です。 "子猫猫又親猫猫又" "子猫親猫猫又猫" はともに最後の猫又で「累計２匹」なのでそこで報告して作業終了です。 |
子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫 |
| 7 | 最後の試練。上司が逆ギレしています。どうやら先程の指示は上司の意図ではなかったようです。彼によると 「猫又が不吉なのは『きっちり２匹だけ並んだ』ときだけだ！」 とのことです。累計でもないしなんと猫又が３匹並んでもそれはOK（カウント継続）だそうです。数えられるかな、、、、 |
コード
手っ取り早いので、正規表現で・・・
メイン処理
参照設定は、いつものやつ。
Microsoft VBScript Regular Expressions 5.5
メイン処理で使っているパターンは、
親猫を数える場合を例に取ると
(?:親)(猫*?)(?=(?:猫又|[^猫]|$))
猫に続く猫又を分けなければいけないので
肯定先読みを使用している。
"親猫又"
がある場合には、
猫又
を優先している。
親猫を優先したい場合には、
"(猫*?)"を"(猫+?)"に変えればいい（はず）。
(?:親)(猫+?)(?=(?:猫又|[^猫]|$))
親の部分が変わるだけで、
Take 1 から、Take 7 まで全て同じパターンで処理している。
Public Function 猫5改2(ByVal sCats As String, ByRef sCatType() As String, ByRef lCatCount() As Long) As Long Dim re As RegExp Dim mc As MatchCollection Dim lCount As Long Dim lNekomata As Long Dim sResult As String Dim sTypes() As String Dim lElems As Long Dim i As Long Dim j As Long ReDim sCatType(lCount) ReDim lCatCount(lCount) '猫又 lNekomata = (Len(sCats) - Len(Replace$(sCats, "猫又", ""))) \ 2 If lNekomata > 0 Then ReDim Preserve sCatType(lCount) sCatType(lCount) = "猫又" ReDim Preserve lCatCount(lCount) lCatCount(lCount) = lNekomata lCount = lCount + 1 End If 猫5改2 = lCount '猫と又を消して、猫の種類の文字のみにする sResult = Replace$(sCats, "猫", "") sResult = Replace$(sResult, "又", "") ReDim sTypes(0) lElems = -1 '"猫"の前に付く文字を抜き出す（"又"は含まれない） Do Until Len(sResult) = 0 lElems = lElems + 1 ReDim Preserve sTypes(lElems) sTypes(lElems) = Left$(sResult, 1) sResult = Replace$(sResult, sTypes(lElems), "") Loop If lElems < 0 Then Exit Function End If Set re = New RegExp With re .Global = True For i = LBound(sTypes) To UBound(sTypes) .Pattern = "(?:" & sTypes(i) & ")(猫*?)(?=(?:猫又|[^猫]|$))" Set mc = .Execute(sCats) sResult = "" For j = 0 To mc.Count - 1 sResult = sResult & mc.Item(j).SubMatches(0) Next j CONTINUE_LOOP: If sCats Like "*" & sTypes(i) & "猫*" Then '"親子猫"のような場合、"親猫"は無いので出力しない If Not sCats Like "*" & sTypes(i) & "猫又*" Then '"子猫又"のような場合、"子猫"を出力しない ReDim Preserve sCatType(lCount) sCatType(lCount) = sTypes(i) & "猫" ReDim Preserve lCatCount(lCount) lCatCount(lCount) = Len(sResult) - Len(Replace$(sResult, "猫", "")) lCount = lCount + 1 End If End If Next i End With 猫5改2 = lCount End Function
Take 6、Take 7用補助処理
Public Function get猫6Source(ByVal sCats As String) As String Dim re As RegExp Dim mc As MatchCollection Dim sSource As String Dim lResult As Long Dim i As Long Set re = New RegExp With re .Pattern = "^(.*?猫又){2}" .Global = False Set mc = .Execute(sCats) If mc.Count > 0 Then sSource = mc.Item(0) Else sSource = sCats End If End With get猫6Source = sSource End Function Public Function get猫7Source(ByVal sCats As String) As String Dim re As RegExp Dim mc As MatchCollection Dim sSource As String Set re = New RegExp With re .Pattern = "^.*?[^又]猫又猫又(?!猫又)" .Global = True Set mc = .Execute(sCats) If mc.Count > 0 Then sSource = mc.Item(0) Else sSource = sCats End If End With get猫7Source = sSource End Function
テスト
Public Sub 猫てすと() Dim sCatType() As String Dim lCatCount() As Long Dim sCats As String Dim lResult As Long '----- take1 ----- Erase sCatType, lCatCount sCats = "親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take2 ----- Erase sCatType, lCatCount sCats = "親猫猫猫子猫猫猫猫猫猫親猫子猫猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take3 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 9 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 '----- take4 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 3 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 4 Debug.Assert sCatType(2) = "親猫" Debug.Assert lCatCount(2) = 4 '----- take5 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 5 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 4 Debug.Assert sCatType(4) = "親猫" Debug.Assert lCatCount(4) = 4 '----- take6-1 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫" sCats = get猫6Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 4 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 1 '----- take6-12 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫青猫親猫猫猫猫" sCats = get猫6Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 1 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 5 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 5 '----- take7-1 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫猫猫又青猫親猫猫猫猫又猫" sCats = get猫7Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 5 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 4 '----- take7-2 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫緑猫青猫猫猫猫親猫猫又猫又青猫親猫猫猫猫又猫" sCats = get猫7Source(sCats) lResult = 猫5改2(sCats, sCatType, lCatCount) Debug.Assert lResult = 7 Debug.Assert sCatType(0) = "猫又" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 2 Debug.Assert sCatType(2) = "白猫" Debug.Assert lCatCount(2) = 1 Debug.Assert sCatType(3) = "黒猫" Debug.Assert lCatCount(3) = 1 Debug.Assert sCatType(4) = "緑猫" Debug.Assert lCatCount(4) = 1 Debug.Assert sCatType(5) = "青猫" Debug.Assert lCatCount(5) = 4 Debug.Assert sCatType(6) = "親猫" Debug.Assert lCatCount(6) = 1 Debug.Print "Done." End Sub
Debug.Assert で済ませたので、イミディエイトウィンドウに
Done.
と出て、終わり。
ちなみに、イミディエイトウィンドウに出力すると、こんな感じ。
以上。
「改2」は、バージョンです。ツッコまないでくださいwww
正規表現を使わないバージョン（2020/3/1追加）
- Take 1～5 限定です。
- 正規表現バージョンより、精度が低いです。
- お題で提示されているデータは、クリアしますが、元になる猫データが変わると、要件をクリアできない場合があります。
- 正規表現バージョンとは、出力順が違います。
コード
Public Function 猫猫(ByVal sCats As String, ByRef sCatType() As String, ByRef lCatCount() As Long) As Long Dim dicCount As Dictionary Dim lLength As Long Dim lStartPos As Long Dim lOffset As Long Dim sCurrentType As String Dim sType As String Dim lCount As Long lLength = Len(sCats) If lLength < 2 Then Exit Function End If Set dicCount = New Dictionary 'グループ開始位置 lStartPos = 1 lOffset = 0 '現在の猫の種類 sCurrentType = "" sType = Mid$(sCats, lStartPos, 1) Do While True Select Case sType Case "猫" If Mid$(sCats, lStartPos + lOffset + 1, 1) <> "又" Then '猫又ではない lCount = lCount + 1 lOffset = lOffset + 1 Else '猫又 lStartPos = lStartPos + lOffset + 2 lOffset = 0 If dicCount.Exists("又") = True Then dicCount.Item("又") = dicCount.Item("又") + 1 Else dicCount.Add "又", 1 End If If Len(sCurrentType) > 0 Then If dicCount.Exists(sCurrentType) = True Then dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If End If sCurrentType = "" End If Case Else If sCurrentType <> sType Then '猫の種類が変わった lStartPos = lStartPos + lOffset + 1 lOffset = 0 If dicCount.Exists(sCurrentType) = True Then 'カウントアップ dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If If Len(sType) > 0 Then If dicCount.Exists(sType) = False Then '新しい猫の種類を追加 dicCount.Add sType, 0 End If End If '現在の猫の種類を更新 sCurrentType = sType 'カウントクリア lCount = 0 Else lOffset = lOffset + 1 End If End Select sType = Mid$(sCats, lStartPos + lOffset, 1) '終了判定（lStartPos + lOffset > lLength で、sType = ""となる） If Len(sType) = 0 Then If Len(sCurrentType) > 0 Then '有効データならカウントアップ dicCount.Item(sCurrentType) = dicCount.Item(sCurrentType) + lCount End If Exit Do End If Loop '-------------------------------------------------- Dim v As Variant Dim lElems As Long ReDim sCatType(dicCount.Count - 1) ReDim lCatCount(dicCount.Count - 1) For Each v In dicCount If Len(v) > 0 Then If dicCount.Item(v) > 0 Then If v <> "又" Then sCatType(lElems) = v & "猫" Else sCatType(lElems) = "猫" & v End If lCatCount(lElems) = dicCount.Item(v) lElems = lElems + 1 End If End If Next v If dicCount.Count <> lElems Then '未登録データが有れば、排除 ReDim Preserve sCatType(lElems - 1) ReDim Preserve lCatCount(lElems - 1) End If 猫猫 = lElems End Function
テスト
Public Sub 猫猫テスト() Dim sCatType() As String Dim lCatCount() As Long Dim sCats As String Dim lResult As Long '----- take1 ----- Erase sCatType, lCatCount sCats = "親猫子猫子猫子猫子猫子猫子猫親猫親猫子猫子猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 3 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take2 ----- Erase sCatType, lCatCount sCats = "親猫猫猫子猫猫猫猫猫猫親猫子猫猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "親猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "子猫" Debug.Assert lCatCount(1) = 8 '----- take3 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫子猫親猫子猫親猫子猫猫子猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 2 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 9 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 '----- take4 ----- Erase sCatType, lCatCount sCats = "子猫猫子猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 3 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 4 Debug.Assert sCatType(1) = "親猫" Debug.Assert lCatCount(1) = 4 Debug.Assert sCatType(2) = "猫又" Debug.Assert lCatCount(2) = 3 '----- take5 ----- Erase sCatType, lCatCount sCats = "子猫猫白猫黒猫猫猫猫親猫猫又猫猫猫又親猫猫猫猫又猫" lResult = 猫猫(sCats, sCatType, lCatCount) Debug.Assert lResult = 5 Debug.Assert sCatType(0) = "子猫" Debug.Assert lCatCount(0) = 2 Debug.Assert sCatType(1) = "白猫" Debug.Assert lCatCount(1) = 1 Debug.Assert sCatType(2) = "黒猫" Debug.Assert lCatCount(2) = 4 Debug.Assert sCatType(3) = "親猫" Debug.Assert lCatCount(3) = 4 Debug.Assert sCatType(4) = "猫又" Debug.Assert lCatCount(4) = 3 Debug.Print "Done." End Sub
【VBA】導関数を求める
Twitter でのお題
「y = 5x^3 + 2x^2 + 7x + 5」の導関数を求めろ！
を解いてみた。
正規表現を使って、必要なデータを取り出して、ゴニョゴニョしました。
使用したパターンは、以下の通り。
"([+-]?)(\d*)x(\^([+-]?\d+))?"
大雑把な説明
x に対して、
| [+-]? | 符号 + または、- が付く場合がある |
| \d* | 任意の正の整数の係数が付く場合がある |
| (\^([+-]?\d+))? | 冪乗指数が付く場合がある |
| [+-]? | 冪乗指数には、符号 + または、- が付く場合がある |
| \d+ | 冪乗指数は、正の整数である |
係数、指数を
正の整数
としているのは、
符号部と数値部を別に判定しているためです。
参照設定は、お約束の通り。
Private Type xItem xiSign As String xiCoefficient As Long xiPower As Long End Type Public Sub hoge() Dim sFormula As String sFormula = "y = 5x^3 + 2x^2 + 7x + 5" Debug.Print sFormula Debug.Print getDerivative改(sFormula) Debug.Assert getDerivative改(sFormula) = "y=15x^2+4x+7" sFormula = "y = 7x - 5x^3 + 2x^2" Debug.Print sFormula Debug.Print getDerivative改(sFormula) Debug.Assert getDerivative改(sFormula) = "y=7-15x^2+4x" sFormula = "y = 7x^+9-3x^5+12x^-3-x^2+10x+4" Debug.Print sFormula Debug.Print getDerivative改(sFormula) Debug.Assert getDerivative改(sFormula) = "y=63x^8-15x^4-36x^-4-2x+10" sFormula = "y = 7x^9-3x^5-22x^-3+4x^2+x+4" Debug.Print sFormula Debug.Print getDerivative改(sFormula) Debug.Assert getDerivative改(sFormula) = "y=63x^8-15x^4+66x^-4+8x+1" sFormula = "y = 5" Debug.Print sFormula Debug.Print getDerivative改(sFormula) Debug.Assert getDerivative改(sFormula) = "" End Sub Private Function getDerivative改(ByVal sFormula As String) As String Dim xi() As xItem Dim sFormulaW As String Dim sItem As String Dim sSign As String Dim sResult As String Dim i As Long sFormulaW = Replace$(sFormula, " ", "") If Not getItemInfo改(sFormulaW, xi) Then Debug.Print "Not matched." Exit Function End If For i = 0 To UBound(xi) With xi(i) If (.xiSign = "-") Eqv (Sgn(.xiPower) < 0) Then sSign = "+" Else sSign = "-" End If sItem = sSign & CStr(.xiCoefficient * Abs(.xiPower)) & "x" '指数部の値による処理の振り分け Select Case .xiPower Case 0 '何も付加しない Case 1 '符号、係数部のみ使用し、"x"および指数部は付加しない sResult = sResult & .xiSign & CStr(.xiCoefficient) Case 2 '指数部は１なので、"^"以降は省略する sResult = sResult & sItem Case Else '指数部が２より大きい or ０未満 sResult = sResult & sItem & "^" & CStr(.xiPower - 1) End Select End With Next i If Left$(sResult, 1) = "+" Then sResult = Mid$(sResult, 2) End If getDerivative改 = "y=" & sResult End Function Private Function getItemInfo改(ByVal sFormula As String, ByRef xi() As xItem) As Boolean Dim re As New RegExp Dim mc As MatchCollection Dim i As Long With re .Global = True .MultiLine = False .IgnoreCase = True .Pattern = "([+-]?)(\d*)x(\^([+-]?\d+))?" End With Set mc = re.Execute(sFormula) If mc.Count = 0 Then Exit Function End If ReDim xi(mc.Count - 1) For i = 0 To mc.Count - 1 With xi(i) .xiSign = mc.Item(i).SubMatches(0) If mc.Item(i).SubMatches(1) = "" Then .xiCoefficient = 1 Else .xiCoefficient = CLng(mc.Item(i).SubMatches(1)) End If If mc.Item(i).SubMatches(3) = "" Then .xiPower = 1 Else .xiPower = CLng(mc.Item(i).SubMatches(3)) End If End With Next i getItemInfo改 = True End Function
実行結果
y = 5x^3 + 2x^2 + 7x + 5
y=15x^2+4x+7
y = 7x - 5x^3 + 2x^2
y=7-15x^2+4x
y = 7x^+9-3x^5+12x^-3-x^2+10x+4
y=63x^8-15x^4-36x^-4-2x+10
y = 7x^9-3x^5-22x^-3+4x^2+x+4
y=63x^8-15x^4+66x^-4+8x+1
y = 5
Not matched.Not matched.
ちなみに、同じく正規表現を使用た方法は、こちらにも。
infoment.hatenablog.com
ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その６ デバッグ編
初めに
DLLを作ってきましたが、作ったからには、動作確認が必要です。
今回は、DLLのデバッグ方法についてです。
このシリーズの記事を読んでくださった方は、基本的にVBAのデバッグ経験者と思います。
ブレークポイントを設定して、ステップ実行したり・・・
基本的な部分は、DLLのデバッグでも同様です。
私の場合、VBAのコードから、DLLのコードにどうやって入っていくのかが
最初の時、わからなかったのでそのあたりについて説明します。
（VBAでのデバッグ経験があることを前提に、類似した細かい部分は、端折ります。）
キーワード
アタッチ
アタッチとは、
デバッガーがプロセスやタスクを監視対象にすること
https://www.wdic.org/w/TECH/%E3%82%A2%E3%82%BF%E3%83%83%E3%83%81
今回の場合、Excelに接続して、監視できるようにするといった感じでしょうか。
デタッチ
こちらは、アタッチの逆。
アタッチした対象を監視下から外して、切り離すことです。
実際にやってみる
操作の流れ
- DLLを呼び出すExcelファイルの起動
- Visual Studio（DLLソリューション）の起動
- アタッチ
- DLL側コードへのブレークポイント設定
- VBAからDLL関数の呼び出し
- DLLコードのステップ実行
- デタッチ
アタッチ
- 対象のExcelファイルと、DLLソリューションを開く。
- Visual Studioのソリューション構成が「Debug」になっているか、確認しておくこと。
- DLLのプロジェクトがビルド済みであること。
- Visual Studioのソリューション構成が「Debug」になっているか、確認しておくこと。
- Visual Studioのメニューから、プロセスにアタッチを選択。
- 「デバッグ」-「プロセスにアタッチ」をクリック
- 「デバッグ」-「プロセスにアタッチ」をクリック
- プロセスにアタッチダイアログから、DLLの呼び出し元となるExcelを探して、選択し、アタッチボタンをクリック。
ブレークポイント
デバッグを開始する部分に、ブレークポイントを設定する。
F9キーで、ブレークポイントの設定、解除ができます。
ブレークポイントを設定したら、VBA側からDLLの関数を呼び出すコードを実行します。
ステップオーバー
１コードステートメントを実行します。
ステップインと違うのは、対象行が、関数の呼び出しの場合、
呼び出し先の関数を実行しますが、呼び出し先関数の内部コードをステップ実行しません。
ショートカットキーは、F10キーです。
ステップアウト
ステップインとは逆に、ステップインした関数から抜ける場合に使用します。
ショートカットキーは、Shift + F11キーです。
デバッグの停止
全てデタッチ
プロセスに再アタッチ
一度アタッチしたプロセスをデタッチした後に、再度同じプロセスにアタッチしたい場合には、プロセスに再アタッチを選択すると、アタッチするプロセスを選択する手間が省けます。
ショートカットキーは、Shift + Alt + P です。
ウォッチ
変数を右クリックして、ウォッチの追加をクリック
確認してみる。
自動変数
ウォッチのように自分で追加しなくても、スコープに応じて表示される変数が変わっていく。
ローカル
ウォッチのように自分で追加しなくても、スコープに応じて表示される変数が変わっていく。
主なショートカットキー
VBA と Visual Studio では、微妙にショートカットキーが違うので・・・
VBE でF8キーを押して、Visula Studio に入っても、F8キーを押して、
「あれ、進まない？あっ、F10だった。」とかよくやってますwww
| 項目 | VBA | Visual Studio | 備考 |
|---|---|---|---|
| ブレークポイントの設定/解除 | F9 | F9 | |
| 全てのブレークポイントの解除 | Ctrrl + Shift + F9 | Ctrrl + Shift + F9 | |
| ステップイン | F8 | F11 | |
| ステップオーバー | Shift + F8 | F10 | |
| ステップアウト | Ctrl + Shift + F8 | Shift + F11 | |
| カーソル行の前まで実行 | Ctrl + F8 | Ctrl + F10 | |
| デバッグの停止 | Shift + F5 |
その他（情報提供依頼）
Rubberduckというアドインがあって、便利そうだのだけど、
こいつをインストールしたところ、Visual Studioでアタッチしても、ExcelのVBEから入っていけない（デバッグできない）現象に遭遇。
現状アンイストールしか対応方法がわからずじまい。
解決策をご存知の方、いらっしゃいましたら教えてください。
最後に
今回で、VBAで使えるDLL作成に関する記事は終了です。
後半は、手抜き気味のような気もしますが、参考になれば幸いです。
ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その５ 構造体の受け渡し
初めに
これまで、数値、文字列、配列、バリアントと各種の型の受け渡しとやってきましたが、今回は、構造体です。
構造体は、VBAとDLLのそれぞれでの定義を間違えると、
- 正しいデータの受け渡しが出来ない
- 正しくデータを読み込めない
- 正しくデータを更新できない
といった事になりかねません。
VBA側、DLL側の両方で、正しい定義を行い、十分な確認をすることが必要です。
事前準備
アライメント
構造体を扱う場合、注意が必要なのはアライメントです。
アライメントについては、以下のサイトに詳しく書かれているので、参考にしてください。
www7b.biglobe.ne.jp
www5d.biglobe.ne.jp
アライメントを調整する方法としては、
- #pragma pack(n) を使用する
- 構造体のメンバーに、アライメントを調整するためのダミーメンバーを加える
などがあります。
#pragma pack の使用については、Microsoft のサイト内に、以下のような記述があります。
VBA では、ユーザー定義データ型のデータ要素は 4 バイト境界にパッキングされます。
Visual Studio では、このデータ要素が既定で 8 バイト境界にパッキングされます。
そのため、C/C++ 構造体の定義は#pragma pack(4) //ここに構造体を定義 #pragma pack()ブロックで囲んで要素の配置がずれないようにする必要があります。
https://docs.microsoft.com/ja-jp/office/client-developer/excel/how-to-access-dlls-in-excel#argument-types-in-cc-and-vba
#pragma pac による要素の配置への影響の確認
以下のような構造体を定義。
VBA
Private Type SampleType iValue As Integer dValue As Double lValue As Long End Type Private Type SampleTypeWithDummy iValue As Integer byDummy(0 To 5) As Byte dValue As Double lValue As Long End Type Private Type SampleTypeWithDummy2 iValue As Integer byDummy(0 To 5) As Byte dValue As Double lValue As Long lDummy As Long End Type
DLL
struct SampleNoPack { short nValue; double dValue; long lValue; }; struct SampleNoPackWithDummy { short nValue; char cDummy[6]; double dValue; long lValue; }; struct SampleNoPackWithDummy2 { short nValue; char cDummy[6]; double dValue; long lValue; long lDummy; }; #pragma pack(4) struct SamplePack { short nValue; double dValue; long lValue; }; #pragma pack()
VBAから、DLLの関数に渡してみる。
__declspec(dllexport) void WINAPI SetStructP(SamplePack* pst); __declspec(dllexport) void WINAPI SetStructNP(SampleNoPack* pst); __declspec(dllexport) void WINAPI SetStructNPWD(SampleNoPackWithDummy* pst); __declspec(dllexport) void WINAPI SetStructNPWD2(SampleNoPackWithDummy2* pst);
なお、各構造体のメンバーには、以下の値を設定しました。
| メンバー | 値 | 色（下図） |
|---|---|---|
| iValue | 0x1234 | 黄 |
| dValue | 3.5 | マゼンタ |
| lValue | 0x56789ABC | シアン |
それぞれのDLL内でのメモリ上の状態は、以下のようになりました。
pacあり、ダミーメンバーなし
配置は同一となったVBAから渡した場合 （SampleType → SamplePack）
DLL内で宣言した場合
pacなし、ダミーメンバーなし
配置は異なるというか、構造体のサイズ自体が異なる。
- LenB(SampleType):16
- sizeof(SampleNoPack):24
このため、正しい値を渡すことが出来ない。
VBAから渡した場合（SampleType → SampleNoPack）
DLL内で宣言した場合
プロシージャを抜ける際に、以下のエラーメッセージが表示された。
pacなし、ダミーメンバーあり
配置は同一となったように見えるこちらも、構造体のサイズ自体が異なる。
- LenB(SampleTypeWithDummy):20
- sizeof(SampleNoPackWithDummy):24
前述のパターンと違い、こちらの場合は、メンバーの配置が同一のため、値の受け渡しは出来た。
VBAから渡した場合（SampleTypeWithDummy → SampleNoPackWithDummy）
DLL内で宣言した場合
pacなし、ダミーメンバーあり２
配置は同一となったこちらは、構造体のサイズが同じ。
- LenB(SampleTypeWithDummy2):24
- sizeof(SampleNoPackWithDummy2):24
VBAから渡した場合（SampleTypeWithDummy2 → SampleNoPackWithDummy2）
DLL内で宣言した場合
VBAから渡した方の最後の部分4Byteが0x00 × 4 でないのは、VBA側で値を設定したためなので、ここは気にしないで下さい。
メモ
アライメントの調整によりメンバー間に発生する領域は、
- VBAから渡された場合、0x00で埋められている。
- DLLで生成した変数の場合、0xCCで埋められている。（Visual Studio C++ では、未初期化の場合、この値になるようです。）
となり、全く同じにはなっていない。（DLL側で、変数宣言時に、0x00で初期化すれば、VBAと同じ状態にすることは可能）
構造体の構成によっては、アライメントの調整は不要となる場合もありえるが、後々変更が発生する可能性があるのであれば、予め対応しておいた方が良さそう。
コード
DLL
AccessibleFromVBA.h
#pragma once extern "C" { #define ACCESSIBLEFROMVBA_API __declspec(dllexport) //中略 #pragma pack(4) struct SamplePack { short nValue; double dValue; long lValue; }; #pragma pack() ACCESSIBLEFROMVBA_API void WINAPI GetStructP(SamplePack* pst); ACCESSIBLEFROMVBA_API void WINAPI GetStructPArray(LPSAFEARRAY* ppsa); ACCESSIBLEFROMVBA_API void WINAPI SetStructP(const SamplePack* pst); ACCESSIBLEFROMVBA_API void WINAPI SetStructPArray(const LPSAFEARRAY* ppsa); }
AccessibleFromVBA.cpp
追加分ACCESSIBLEFROMVBA_API void WINAPI SetStructP(const SamplePack* pst) { std::wstringstream ss; ss << pst->nValue << L"\n" << pst->dValue << L"\n" << pst->lValue << L"\n"; MessageBox(NULL, ss.str().c_str(), L"SetStructP", MB_OK | MB_ICONINFORMATION); return; } ACCESSIBLEFROMVBA_API void WINAPI SetStructPArray(const LPSAFEARRAY* ppsa) { //格納されているデータ型の確認 VARTYPE vt; HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt); if (SUCCEEDED(hResult)) { //VBAから構造体を渡した場合、hResult は、E_INVALIDARG が返るので //FAILED(hResult) で弾かない。 return; } //要素のサイズ UINT uiElemBytes = SafeArrayGetElemsize(*ppsa); if (uiElemBytes != sizeof(SamplePack)) { //構造体のサイズと異なる場合、処理しない。 return; } //次元数 UINT uiDims = SafeArrayGetDim(*ppsa); std::wstringstream ss; for (UINT i = 1; i <= uiDims; ++i) { LONG lLBound, lUBound; hResult = SafeArrayGetLBound(*ppsa, i, &lLBound); hResult = SafeArrayGetUBound(*ppsa, i, &lUBound); ss << i << L"次元\n" << L" LBound：" << lLBound << L"\n" << L" UBound：" << lUBound << L"\n"; } ss << L"データ型：SamplePack\n"; if (uiDims == 1) { LONG lIndex; LONG lLBound; LONG lUBound; hResult = SafeArrayGetLBound(*ppsa, 1, &lLBound); hResult = SafeArrayGetUBound(*ppsa, 1, &lUBound); for (LONG i = lLBound; i <= lUBound; ++i) { SamplePack sp; hResult = SafeArrayGetElement(*ppsa, &i, &sp); ss << sp.nValue << L"\n" << sp.dValue << L"\n" << sp.lValue << L"\n" << L"\n"; } } MessageBox(NULL, ss.str().c_str(), L"SetStructPArray", MB_OK | MB_ICONINFORMATION); return; } ACCESSIBLEFROMVBA_API void WINAPI GetStructP(SamplePack* pst) { pst->nValue *= 2; pst->dValue *= 2; pst->lValue *= 2; return; } ACCESSIBLEFROMVBA_API void WINAPI GetStructPArray(LPSAFEARRAY* ppsa) { //格納されているデータ型の確認 VARTYPE vt; HRESULT hResult = SafeArrayGetVartype(*ppsa, &vt); if (SUCCEEDED(hResult)) { //VBAから構造体を渡した場合、hResult は、E_INVALIDARG が返るので //FAILED(hResult) で弾かない。 return; } //要素のサイズ UINT uiElemBytes = SafeArrayGetElemsize(*ppsa); if (uiElemBytes != sizeof(SamplePack)) { //構造体のサイズと異なる場合、処理しない。 return; } //次元数 UINT uiDims = SafeArrayGetDim(*ppsa); if (uiDims == 1) { LONG lLBound; LONG lUBound; hResult = SafeArrayGetLBound(*ppsa, 1, &lLBound); hResult = SafeArrayGetUBound(*ppsa, 1, &lUBound); for (LONG i = lLBound; i <= lUBound; ++i) { SamplePack sp; hResult = SafeArrayGetElement(*ppsa, &i, &sp); sp.nValue *= 2; sp.dValue *= 2; sp.lValue *= 2; hResult = SafeArrayPutElement(*ppsa, &i, &sp); } } return; }
AccessibleFromVBA.def
LIBRARY AccessibleFromVba
EXPORTS
DoNothing
GetNumberI
GetNumberI2
SetString
SetStringS
GetStringByParam
GetStringByParamS
GetStringByRetVal
GetStringByRetValS
GetArrayPE
GetArrayAD
GetArray2
SetArrayGE
SetArrayAD
GetArrayV
SetArrayV
GetStructP
GetStructPArray
SetStructP
SetStructPArray
VBA
Private Type SampleType iValue As Integer dValue As Double lValue As Long End Type Private Declare Sub SetStructP Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef udtSample As SampleType) Private Declare Sub SetStructPArray Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef udtSample() As SampleType) Private Declare Sub GetStructP Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef udtSample As SampleType) Private Declare Sub GetStructPArray Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef udtSample() As SampleType) Public Sub DllTestSetStruct() Dim udtSample As SampleType udtSample.iValue = 18 udtSample.dValue = 3.5 udtSample.lValue = 52 Call SetStructP(udtSample) End Sub Public Sub DllTestSetStructArray() Dim udtSample(1) As SampleType udtSample(0).iValue = 1234 udtSample(0).dValue = 3.5 udtSample(0).lValue = 56789 udtSample(1).iValue = 3456 udtSample(1).dValue = 4.5 udtSample(1).lValue = 7890 Call SetStructPArray(udtSample) End Sub Public Sub DllTestGetStruct() Dim udtSample As SampleType udtSample.iValue = 1000 udtSample.dValue = 3.5 udtSample.lValue = 200000 Debug.Print "Before" Debug.Print udtSample.iValue, udtSample.dValue, udtSample.lValue Call GetStructP(udtSample) Debug.Print "After" Debug.Print udtSample.iValue, udtSample.dValue, udtSample.lValue End Sub Public Sub DllTestGetStructArray() Dim udtSample(1) As SampleType Dim i As Long udtSample(0).iValue = 1000 udtSample(0).dValue = 3.5 udtSample(0).lValue = 2000000 udtSample(1).iValue = 3000 udtSample(1).dValue = 4.5 udtSample(1).lValue = 6000000 Debug.Print "Before" For i = LBound(udtSample) To UBound(udtSample) Debug.Print udtSample(i).iValue, udtSample(i).dValue, udtSample(i).lValue Next i Call GetStructPArray(udtSample) Debug.Print "After" For i = LBound(udtSample) To UBound(udtSample) Debug.Print udtSample(i).iValue, udtSample(i).dValue, udtSample(i).lValue Next i End Sub
実行結果
DllTestSetStruct
DllTestSetStructArray
DllTestGetStruct
Before 1000 3.5 200000 After 2000 7 400000
DllTestGetStructArray
Before 1000 3.5 2000000 3000 4.5 6000000 After 2000 7 4000000 6000 9 12000000
まとめ
構造体の受け渡しでは、アライメントに十分に気をつける必要があることが確認できました。
構造体の配列の受け渡しは、SAFEARRAYで処理しようとした場合、これまでのやり方のように、vtで型を判断することが出来ず、構造体のサイズで判断しました。
調べていると、VT_RECORD というキーワードが出てくるが、VBAではなく、VBでの処理であり、いろいろと面倒な手続きがあるようで、VBAでの方法を見つけられず、上記のような処理で妥協していまいました。
次回予告
次回はDLLのデバッグの方法を簡単に説明して、このシリーズを終了とするつもりです。
ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その４．３（非配列Variant型変数による配列受け渡し編）
初めに
前回の予告通り、今回は非配列のVariant型変数に配列を格納して、DLLとの受け渡しをしてみます。
処理
処理方法は、これまでにやってきた事の組み合わせで出来ます。
DLL側でVariant型を受け取る処理は、文字列の受け渡しを行った時と同じ。
受け取ってから、VARIANT型変数のvtを見て、配列かどうかの判断を行います。
配列であることの確認できれば、VARIANT型変数のparrayに目的のSAFEARRAYがあります。
SAFEARRAYがわかれば、あとは、前回の処理を使えます。
コード
DLL
AccessibleFromVBA.h
追加分ACCESSIBLEFROMVBA_API void WINAPI GetArrayV(LPVARIANT pv); ACCESSIBLEFROMVBA_API void WINAPI SetArrayV(const LPVARIANT pv);
AccessibleFromVBA.cpp
AccessibleFromVBA.def
LIBRARY AccessibleFromVba
EXPORTS
DoNothing
GetNumberI
GetNumberI2
SetString
SetStringS
GetStringByParam
GetStringByParamS
GetStringByRetVal
GetStringByRetValS
GetArrayPE
GetArrayAD
GetArray2
SetArrayGE
SetArrayAD
GetArrayV
SetArrayV
VBA
Private Declare Sub SetArrayV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef v As Variant) Private Declare Sub GetArrayV Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef v As Variant) Public Sub DllTestSetArrayV() Dim v As Variant Dim lArray(3, 1) As Long Dim sArray() As String Dim dArray(2) As Double Dim i As Long Dim j As Long ReDim sArray(2) sArray(0) = "Z1000" sArray(1) = "ZX-10R" sArray(2) = "Kawasaki" v = sArray Call SetArrayV(v) ReDim sArray(2, 2) v = sArray Call SetArrayV(v) For i = LBound(lArray, 1) To UBound(lArray, 1) For j = LBound(lArray, 2) To UBound(lArray, 2) lArray(i, j) = (i + 1) * 10 + j Next j Next i 'Arrayを使った場合、DLL側では、vt が VT_VARIANT | VT_ARRAY になるので注意が必要 '以下のコメントしたコードでは、VT_I4 | VT_ARRAY にはならない。 ' v = Array(1&, 2&, 3&, 4&) v = lArray Call SetArrayV(v) v = dArray Call SetArrayV(v) End Sub Public Sub DllTestGetArrayV() Dim vL As Variant Dim vS As Variant Dim i As Long ReDim vL(3) As Long vL(0) = 100 vL(1) = 200 vL(2) = 300 vL(3) = 400 Debug.Print "Before" For i = LBound(vL) To UBound(vL) Debug.Print i, vL(i) Next i Call GetArrayV(vL) Debug.Print vbCrLf & "After" For i = LBound(vL) To UBound(vL) Debug.Print i, vL(i) Next i Debug.Print "" ReDim vS(2) As String vS(0) = "Z1000" vS(1) = "ZX-10R" vS(2) = "Ninja 900R" Debug.Print "Before" For i = LBound(vS) To UBound(vS) Debug.Print i, vS(i) Next i Call GetArrayV(vS) Debug.Print vbCrLf & "After" For i = LBound(vS) To UBound(vS) Debug.Print i, vS(i) Next i End Sub
実行結果
DllTestSetArrayV
DllTestGetArrayV
Before 0 100 1 200 2 300 3 400 After 0 200 1 400 2 600 3 800 Before 0 Z1000 1 ZX-10R 2 Ninja 900R After 0 Z1000 GetArrayV 0 1 ZX-10R GetArrayV 1 2 Ninja 900R GetArrayV 2
ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その４．２（配列編）
- 初めに
- SAFEARRAYに関する追加情報
- 主な処理と使用する関数
- HRESULTを返す関数の成否判定
- SAFEARRAYに格納されている要素のデータ型分類値の取得
- 配列の次元数の取得
- 配列の１要素のサイズの取得
- 指定した次元のインデックスの指定可能最小値(LBound)の取得
- 指定した次元のインデックスの指定可能最大値(UBound)の取得
- 配列のロックカウントをインクリメントと、配列データへのポインターの取得
- 配列のロックカウントをデクリメントと、SafeArrayAccessDataによって取得されたポインターの無効化
- 配列記述子と配列内のすべてのデータの破棄
- 配列の単一の要素の取得
- データ要素を配列内の指定された場所に保存
- 配列内のすべてのデータの破棄
- VBAからDLLへ渡す
- DLLからVBAへ返す
- コード
- 実行結果
- 次回予告
- 過去掲載分
初めに
前回は、予定を変更して、String型の受け渡しをする方法についてまとめました。
今回は、SAFEARRAYについてどのようなものか調べた前々回の続編です。
実際に配列データの受け渡しを行います。
SAFEARRAYに関する追加情報
配列要素のデータ型
前回の記事で、気が付いた人もいるかもしれないが、SAFEARRAY構造体のメンバーには配列要素の型情報がない。
fFeatures に、VARIANT型およびBSTR型の場合に立つフラグがあるが、それ以外の型の場合、構造体メンバーだけでは判断ができない。
これについては、後述する型判定関数があるので、基本的な型であれば問題ない。
引数
VBAでは、配列はByValでは引数に指定できないので、ByRef指定となる。
そのため、DLL側では、SAFEARRAYの受け渡しをするために、引数は、
SAFEARRAYを指すポインタ（SAFEARRAY*）ではなく、
SAFEARRAYを指すポインタへのポインタ（SAFEARRAY**）とする。
一方、呼び出すVBA側では、Declare で受け渡しをする引数をどの様に書けばいいのか？
VBAには、SAFEARRYなるデータ型はない。
結論から言えば、通常のプロシージャと同様で、下記のようになる。
Declare Sub 関数名 Lib "DLL名" (ByRef 配列変数名() As データ型)
As Byteだろうが
As Longだろうが
As Variantだろうが
構わない。
言い換えれば、下記のように、Declare でAlias を設定すれば、DLLのひとつの関数で異なるデータ型の受け渡しも可能となる。
DLLの関数宣言
__declspec(dllexport) void WINAPI FuncX(LPSAFEARRAY* ppsa);
VBA側の宣言
上記のDLLの関数宣言に対し、以下の宣言は、いずれも問題ない。
Declare Sub XByte Lib "DLL名" Alias "FuncX" (ByRef 配列変数名() As Byte) Declare Sub XLong Lib "DLL名" Alias "FuncX" (ByRef 配列変数名() As Long) Declare Sub XVariant Lib "DLL名" Alias "FuncX" (ByRef 配列変数名() As Variant)
主な処理と使用する関数
HRESULTを返す関数の成否判定
いくつかの関数は復帰値の型が、HRESULTとなっている。
これらの関数は、成功すると S_OK （0x00000000）を返す。
成功を判定するマクロとして、SUCCEEDED マクロがあり、
失敗を判定するマクロとして、FAILED マクロがあるので、必要に応じて使えばよい。
使用例
HRESULT hResult = SafeArrayAccessData(*ppsa, (void**)&piValue); if (FAILED(hResult)) return;
HRESULT が取る値（抜粋？）については、こちらに記載されている。
SAFEARRAYに格納されている要素のデータ型分類値の取得
SafeArrayGetVartype
HRESULT SafeArrayGetVartype( SAFEARRAY *psa, VARTYPE *pvt );
VBAから渡した場合、VERTYPEは、以下のような値を取る。
| 項目 | データ型 | 値 | 備考 | |
|---|---|---|---|---|
| VBA | C++ | |||
| VT_I2 | Integer | short | 0x0002 | |
| VT_I4 | Long | int | 0x0003 | |
| VT_R4 | Single | float | 0x0004 | |
| VT_R8 | Double | double | 0x0005 | |
| VT_CY | Currency | CY | 0x0006 | |
| VT_DATE | Date | DATE | 0x0007 | |
| VT_BSTR | String | BSTR | 0x0008 | |
| VT_BOOL | Boolean | BOOL | 0x00B | |
| VT_VARIANT | Variant | VARIANT | 0x00C | |
| VT_UI1 | Byte | unsigned char | 0x0011 | |
| VT_I8 | LongLong | long long | 0x0014 | 64bit版のみ |
配列の１要素のサイズの取得
SafeArrayGetElemsize
UINT SafeArrayGetElemsize( SAFEARRAY *psa );
例えば、VBA側で、
Dim arryL(2) As Long Dim arryV(2) As Variant Dim arryS(2) As String
と宣言されていた場合、
arryLは、Longのサイズになるので、4 (Byte)が返る。
arryVは、Variantのサイズになるので、16 (Byte)が返る。
arrySは、Stringのポインタサイズ（？）になるので、4 (Byte)が返る。
指定した次元のインデックスの指定可能最小値(LBound)の取得
SafeArrayGetLBound
HRESULT SafeArrayGetLBound( SAFEARRAY *psa, UINT nDim, LONG *plLbound );
nDim は、対象となる次元。
左端の次元が１となり、右に行くと増えていく。
指定方法が、SAFEARRAY メンバーの rgsabound[n].lLbound とは異なるので、何らかの理由で両関数を使い分ける必要がある場合には注意が必要。
Dim arryL(1 To 2, 3 To 5) As Long
の場合、
| nDim | Lbound |
|---|---|
| 1 | 1 |
| 2 | 3 |
となる。
SAFEARRAYのメンバー、rgsabound[n].lLbound を参照して取得する方法もある。
指定方法は、前回のrgsaboundの説明を参照。
SafeArrayGetLBound の方が、直感的に指定しやすい。
指定した次元のインデックスの指定可能最大値(UBound)の取得
SafeArrayGetUBound
HRESULT SafeArrayGetUBound( SAFEARRAY *psa, UINT nDim, LONG *plUbound );
SafeArrayGetLBound と同様。
こちらは、SAFEARRAYに直接取得できるメンバーはない。
rgsabound[n].lLbound + rgsabound[n].cElements - 1
で計算はできる。
配列のロックカウントをインクリメントと、配列データへのポインターの取得
SafeArrayAccessData
HRESULT SafeArrayAccessData(
SAFEARRAY *psa,
void HUGEP **ppvData
);
ポインタを使って、要素にアクセスする場合に使用するものらしい。
配列データへのポインタを返すのと同時に、SafeArrayへのロックを行う。
SAFEARRAY ppvData 使用後、SafeArrayUnaccessData を呼び出さなければいけない。
SafeArrayGetElement および SafeArrayPutElement を使用するよりも高速に処理ができるらしい。
This approach is faster than using SafeArrayGetElement and SafeArrayPutElement.
https://docs.microsoft.com/ja-jp/windows/win32/api/oleauto/nf-oleauto-safearrayaccessdata?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev15.query%3FappId%3DDev15IDEF1%26l%3DJA-JP%26k%3Dk(OLEAUTO%2FSafeArrayAccessData)%3Bk(SafeArrayAccessData)%3Bk(DevLang-C%2B%2B)%3Bk(TargetOS-Windows)%26rd%3Dtrue#examples
多次元配列の場合、前回の記事に記載の通り、ポインタのインクリメントと配列のインデックスに注意が必要。
HUGEP は正直なところ、よくわかっていない。
１６bit時代（？）に使われていたみたいだが・・・
省略して、単に void** にキャストしても、データは取得できた。
とりあえず、使わない方向で行くことに・・・
配列のロックカウントをデクリメントと、SafeArrayAccessDataによって取得されたポインターの無効化
SafeArrayUnaccessData
HRESULT SafeArrayUnaccessData( SAFEARRAY *psa );
SafeArrayAccessData によりロックした配列のアンロックを行う。
配列記述子と配列内のすべてのデータの破棄
SafeArrayDestroy
HRESULT SafeArrayDestroy( SAFEARRAY *psa );
配列の単一の要素の取得
SafeArrayGetElement
HRESULT SafeArrayGetElement(
SAFEARRAY *psa,
LONG *rgIndices,
void *pv
);
rgIndices
配列の各次元のインデックスのベクトル。右端（最下位）の次元はrgIndices [0]
左端の次元は、rgIndices [psa-> cDims – 1]
２次元以上の配列の場合、要素数が配列の次元数のlong型の配列を用意して、
取得したい要素の各次元のインデックスを格納して、関数に渡す。
Dim arry(3, 3, 3) As Long
という配列があり、arry(1, 2, 3) の要素を取得したい場合には、以下のようにすればよい。
long lIndex[] = {1, 2, 3}; int iValue; SafeArrayGetElement(*ppsa, lIndex, &iValue);
pv
取得した要素を格納する変数データ要素を配列内の指定された場所に保存
SafeArrayPutElement
HRESULT SafeArrayPutElement(
SAFEARRAY *psa,
LONG *rgIndices,
void *pv
);
使い方は、SafeArrayGetElementと同様。（pvは、書き込むデータ）
long lValue = getSomeValue();
SafeArrayPutElement(*ppsa, &lIndex, &lValue);
ただし、BSTRの場合は注意が必要。
BSTR bstr;
bstr = SysAllocStringByteLen(pszReturn, lenByte);
//&bstrではないので注意！！！(& は不要)
SafeArrayPutElement(*ppsa, &lIndex, bstr);
配列内のすべてのデータの破棄
SafeArrayDestroy
HRESULT SafeArrayDestroy( SAFEARRAY *psa );
既存の配列記述子と配列内のすべてのデータを破棄します。オブジェクトが配列に格納されている場合、配列内の各オブジェクトでReleaseが呼び出されます。
docs.microsoft.com
VBAからDLLへ渡す
VBAから渡された配列の値を、メッセージボックスで表示してみました。
処理の流れ
- 格納されているデータ型の確認
- 配列の次元数の確認
- 各次元の要素数、インデックスの上下限の確認
- データ読み込み
- 後処理
DLLからVBAへ返す
VBAから受け取った配列に、何らかの値を格納して返してみました。
処理の流れ
- 格納されているデータ型の確認
- 配列の次元数の確認
- 各次元の要素数、インデックスの上下限の確認
- データ書き込み
- 後処理
コード
DLL
AccessibleFromVBA.h
AccessibleFromVBA.cpp
追加部分のみプロトタイプ宣言
std::wstring convMbc2Wstr(const char* lpcszSrc); std::wstring convMbcBstr2Wstr(const BSTR& bstr);
DLLに配列を渡す処理
DLLで配列を更新して返す処理
文字列変換処理
AccessibleFromVBA.def
実行結果
getArrayPETest
2 3 406 2 4 408 3 3 606 3 4 608 4 3 806 4 4 808 5 3 1006 5 4 1008 GetArrayPE:1 GetArrayPE:2 GetArrayPE:3 GetArrayPE:4 GetArrayPE:5
getArrayADTest
2 3 0x23 2 4 0x24 3 3 0x33 3 4 0x34 4 3 0x43 4 4 0x44 5 3 0x53 5 4 0x54 2 3 0x69 2 4 0x6C 3 3 0x99 3 4 0x9C 4 3 0xC9 4 4 0xCC 5 3 0xF9 5 4 0xFC GetArrayAD0 GetArrayAD1 GetArrayAD2 GetArrayAD3 GetArrayAD4 GetArrayAD_BSTR0 4 GetArrayAD_EMPTY2 GetArrayAD_EMPTY3
setArrayADTest
SetArrayGE
SetArrayAD
次回予告
次回は、Variant型の非配列変数に、配列を格納して、DLLと受け渡しをする予定です。
ExcelのVBAで使えるDLLを、C++（Visual Studio 2017）で作る。・・・その３．２（String型による文字列の受け渡し）
初めに
前回の予告で、「次回は、実際に配列の受け渡しを行ってみます。」などと書いたのだけれど、
「やっぱりString型の配列の受け渡しも欲しいよな。」
となったので、予定を変更して前々回の続編として、
String型で文字列の受け渡しをまとめることにしました。
BSTR
VBAのString型は、BSTR型です。
まずは、BSTRについて調べてみました。
構造
BSTRは、
- 長さのプレフィックス
- データ文字列
- ターミネータ
で構成される複合データ型です。
（C++のヘッダを見ると、BSTRは、上記の「データ文字列」部なのですが・・・。詳細は下記）
| 項目 | データ型 | 説明 |
|---|---|---|
| 長さプレフィックス | ULONG | 次のデータ文字列のバイト数。符号なし4バイト整数。 データ文字列の最初の文字の直前に配置されます。 この値には、ターミネーターは含まれません。 |
| データ文字列 | WCHAR[n] | 複数の埋め込みNULL文字が含まれる場合があります。 データ文字列の終端がNULLである必要はありません。 |
| ターミネーター | WCHAR | 0x0000 (WCHAR) |
メモリ上の配置イメージは、以下のようになります。
ヘッダ内では、以下のように定義されています。
typedef WCHAR OLECHAR; typedef OLECHAR* BSTR; typedef BSTR* LPBSTR;
メモリ管理
BSTRは、std::wstringとは違って、
- 使用する前にメモリの割り当て
- 使用後にメモリの解放
が必要です。
メモリの割り当てには、以下の関数を使用します。
メモリの開放には、以下の関数を使用します。
メモリの割り当て、開放を誰が担当するのかは、ケースによって変わってきます。
BSTRがインターフェイス内にとどまっている場合、操作が完了したらメモリを解放する必要があります。ただし、BSTRがインターフェイスを通過すると、受信オブジェクトがメモリ管理を担当します。
https://docs.microsoft.com/ja-jp/cpp/atl-mfc-shared/allocating-and-releasing-memory-for-a-bstr?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev15.query%3FappId%3DDev15IDEF1%26l%3DJA-JP%26k%3Dk(WTYPES%2FBSTR);k(BSTR);k(DevLang-C%2B%2B);k(TargetOS-Windows)%26rd%3Dtrue&view=vs-2019
- BSTR引数を必要とする関数を呼び出す場合、呼び出しの前にBSTRにメモリを割り当てて、後で解放する必要があります。
- BSTRを返す関数を呼び出すときは、自分で文字列を解放する必要があります。
- BSTRを返す関数を実装する場合、文字列を割り当てますが、解放しないでください。関数を受信すると、メモリが解放されます。
以下は別のサイトに記載されていたもので、原文は英語ですが、Googleさんにお願いして翻訳しました。
インターフェースは契約です。 呼び出し元と呼び出し先に期待される動作を記述します。 「このメモリを解放するのは誰ですか？」 その契約の一部であるため、それを解放する所有者を決定し、それをインターフェイスのドキュメントに書き込みます。
ただし、通常は次のことが予想されます。
- BSTRが「in」パラメータである場合
- 通常、呼び出し側がそれを解放します。 呼び出し先がそれを所有したい場合、呼び出し先はコピーを作成してコピーを所有できます。
- BSTRが「out」パラメータである場合
- エントリでnullである必要があります。そのため、解放する必要はありません。また、明らかに、呼び出し側は結果の文字列を所有します。
- BSTRが「in / out」パラメータである場合
- 呼び出し先は渡された値を解放し、置き換えます。 呼び出し元は、新しい値を解放して所有します。
- BSTRが「out ret」パラメーターである場合
- 明らかに呼び出し側はそれを解放します。
VBはこれらのルールを予期し、呼び出し側であり、呼び出し側が文字列を解放している場合、ユーザーに代わって文字列を解放します。
https://blogs.msdn.microsoft.com/ericlippert/2003/09/12/erics-complete-guide-to-bstr-semantics/#comment-5180
ポインタを介してのデータの書き換え
前述の通り、BSTRは、(WCHARの)ポインタですが、ポインタを使用して、その内容を直接書き換えてはいけません。後述する関数から用途に合ったものを使用して行います。
内部のデータ文字列の状態
BSTR は既知のバイト数であるため、ゼロで文字列を終了するという規則は必要ありません。 したがって、ゼロは BSTR 内の正当な値 です。 これは、 BSTR がバイナリイメージを含む任意のデータを含むことができることを 意味し ます。 このため、 BSTR は、文字列に加えてバイナリデータをマーシャリングする便利な方法としてよく使用されます。 これは 、いくつかの奇妙な状況で は、 BSTR が奇数バイトになる場合があることを 意味し ます。 まれですが、可能性に注意する必要があります。
https://blogs.msdn.microsoft.com/ericlippert/2003/09/12/erics-complete-guide-to-bstr-semantics/
VBAでString型とVariant型の変数に文字列を設定してDLLに渡した場合、DLL内で見たメモリの内容は以下のようになりました。
BSTR型で受けた場合、char[]相当の内容になっています。
VARIANT型で受けた場合、WCHAR[]相当の内容になっています。
渡した文字列は、
- Z1000R：半角英数、偶数文字数
- ZX-10RR：半角英数記号、奇数文字数
- カワサキ：全角カタカナ
の３種類です。
| 受け取る型 | |||
|---|---|---|---|
| BSTR | VARIANT | ||
| 渡す型 | String | Z1000R ZX-10RR  カワサキ  |
Z1000R ZX-10RR  カワサキ  |
| Variant | - | Z1000R ZX-10RR  カワサキ  |
|
アンダーラインの部分の各色の部分は、以下の内容を示しています。
黄色：長さのプレフィックス
シアン：データ文字列
マゼンタ：ターミネーター
「カワサキ」の各文字の文字コードは、以下の通りです。
(CPUがリトルエンディアンなので、メモリのイメージ図上では、上位と下位が入れ替わって配置されています。)
| 種別 | カ | ワ | サ | キ |
|---|---|---|---|---|
| Shift-JIS | 0x834A | 0x838F | 0x8354 | 0x834C |
| UNICODE | 0x30AB | 0x30EF | 0x30B5 | 0x30AD |
「ZX-10RR」は、終端のNULLを除いて、7文字になりますが、String型→BSTR型の場合、前述の通り奇数バイトの値が長さとして設定されているのがわかります。
ヘッダ
WTypes.h
docs.microsoft.com
関数
VBAのString型を使って、DLLとやり取りする場合、主に使用するのは以下の２つ。
- SysAllocStringByteLen
- SysFreeString
SysAllocStringByteLen
ANSI文字列を入力として受け取り、ANSI文字列を含むBSTRを返します。ANSIからUnicodeへの変換を実行しません。
VBA側が、String型で文字列を受け取る場合、この関数を使用します。
BSTR SysAllocStringByteLen( LPCSTR psz, UINT len );
lenは、pszの終端のNULLを含めないByte数を指定する。
また、この値は奇数であっても構わない。
この関数は、バイナリデータを含むBSTRを作成するために提供されています。 このタイプのBSTRは、ANSIからUnicode、またはその逆に変換されない状況でのみ使用できます。
pszがNullの場合、要求された長さの文字列が割り当てられますが、初期化されません。 文字列pszにはヌル文字を埋め込むことができ、ヌルで終わる必要はありません。
SysAllocString
新しい文字列を割り当て、渡された文字列をコピーします。VBA側が、Variant型で文字列を受け取る場合、この関数を使用します。
BSTR SysAllocString(
const OLECHAR *psz
);
SysAllocStringLen
新しい文字列を割り当て、渡された文字列から指定された数の文字をコピーし、NULL終了文字を追加します。BSTR SysAllocStringLen(
const OLECHAR *strIn,
UINT ui
);
uiは、コピーする文字数。
docs.microsoft.com
SysFreeString
VARIANTの時にも使ったやつ。SysAllocString、SysAllocStringByteLen、SysReAllocString、SysAllocStringLen、またはSysReAllocStringLenによって以前に割り当てられた文字列の割り当てを解除します。
docs.microsoft.com
SysStringLen
BSTRの長さを返します。
終端のNULL文字を含まないbstrの文字数。 bstrがnullの場合、戻り値はゼロです。
BSTRにNULL文字が埋め込まれている場合、戻り値はstrlen（bstr）と異なる場合があります。 この関数は、BSTRの割り当てに使用されるSysAllocStringLen関数のcchパラメーターで指定された文字数を常に返します。
https://docs.microsoft.com/ja-jp/windows/win32/api/oleauto/nf-oleauto-sysstringlen#remarks
UINT SysStringLen( BSTR pbstr );
SysStringByteLen
BSTRの長さ（バイト単位）を返します。
終端のNULL文字を含まないbstrのバイト数。 bstrがnullの場合、戻り値はゼロです。
BSTRにNULL文字が埋め込まれている場合、戻り値はstrlen（bstr）と異なる場合があります。 この関数は、BSTRの割り当てに使用されるSysAllocStringByteLen関数のlenパラメーターで指定されたバイト数を常に返します。
https://docs.microsoft.com/ja-jp/windows/win32/api/oleauto/nf-oleauto-sysstringbytelen#remarks
UINT SysStringByteLen( BSTR bstr );
SysAllocStringとSysAllocStringByteLenの違い
SysAllocStringとSysAllocStringByteLenの両関数に同じ内容の文字列（全く同じものではありません）を渡して生成されたBSTRを、VBAのString型で受け取った場合、どのような違いが出るのか試してみました。
| DLL側でのBSTR生成 | VBA側でStringで受けた後の状態 | 備考 |
|---|---|---|
| SysAllocString(L"Z1000R"); | Z 1 0 0 0 R | 文字の間に'\0'が入っており、スペースが挟まれているように見える |
| SysAllocStringByteLen("Z1000R", 6); | Z1000R | 入力したデータが取得できている |
| SysAllocString(L"カワサキ"); | ｫ0・ｵ0ｭ0 | 文字化けしている |
| SysAllocStringByteLen("カワサキ", 8); | カワサキ | 入力したデータが取得できている |
目的に合った関数を使用しましょう。
コード
DLL
AccessibleFromVBA.h
#pragma once extern "C" { #define ACCESSIBLEFROMVBA_API __declspec(dllexport) ACCESSIBLEFROMVBA_API void WINAPI DoNothing(); ACCESSIBLEFROMVBA_API int WINAPI GetNumberI(int i); ACCESSIBLEFROMVBA_API void WINAPI GetNumberI2(int* pi); ACCESSIBLEFROMVBA_API void WINAPI SetString(VARIANT vString); ACCESSIBLEFROMVBA_API void WINAPI SetStringS(const BSTR sString); ACCESSIBLEFROMVBA_API void WINAPI GetStringByParam(VARIANT* pvString); ACCESSIBLEFROMVBA_API void WINAPI GetStringByParamS(BSTR* pbstr); ACCESSIBLEFROMVBA_API VARIANT WINAPI GetStringByRetVal(); ACCESSIBLEFROMVBA_API BSTR WINAPI GetStringByRetValS(); }
AccessibleFromVBA.cpp
追加分のみACCESSIBLEFROMVBA_API void WINAPI GetStringByParamS(BSTR* pbstr) { if (!pbstr) return; //まず開放 SysFreeString(*pbstr); //返す文字列（std::wstringは使用しない） std::string sReturn("GetStringByParamS 返却データ文字列"); //BSTR生成 *pbstr = SysAllocStringByteLen(sReturn.c_str(), sReturn.length()); return; } ACCESSIBLEFROMVBA_API BSTR WINAPI GetStringByRetValS() { //返す文字列（std::wstringは使用しない） std::string s("GetStringByRetValS 返却データ文字列"); //BSTR生成 BSTR bstr = SysAllocStringByteLen(s.c_str(), s.length()); return bstr; } ACCESSIBLEFROMVBA_API void WINAPI SetStringS(const BSTR sString) { if (!sString) { MessageBox(NULL, L"Argment is NULL.", L"DLL", MB_OK | MB_ICONERROR); return; } //VBAからの文字列は、char*で格納されている //BSTRの途中に'\0'がある事は想定していない。 std::string s((char*)sString); MessageBoxA(NULL, s.c_str(), "DLL", MB_OK | MB_ICONINFORMATION); return; }
AccessibleFromVBA.def
LIBRARY AccessibleFromVba
EXPORTS
DoNothing
GetNumberI
GetNumberI2
SetString
SetStringS
GetStringByParam
GetStringByParamS
GetStringByRetVal
GetStringByRetValS
stdafx.h
#pragma once #include "targetver.h" #define WIN32_LEAN_AND_MEAN // Windows ヘッダーから使用されていない部分を除外します。 // Windows ヘッダー ファイル: #include <windows.h> // TODO: プログラムに必要な追加ヘッダーをここで参照してください #include <WTypes.h> //BSTR #include <atlstr.h> //VARIANT #include <iostream> #include <string>
VBA
Private Declare Sub SetStringS Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByVal s As String) Private Declare Sub GetStringByParamS Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" (ByRef s As String) Private Declare Function GetStringByRetValS Lib "C:\Datas\MyDatas\Developer\VisualStudioComunity2017\DllForVBA\ForTest\AccessibleFromVBA.dll" () As String Public Sub DllCallTest() Dim s As String Call GetStringByParamS(s) Debug.Print "GetStringByParamS:" & s s = "" s = GetStringByRetValS Debug.Print "GetStringByRetValS:" & s s = "Z1000R" Call SetStringS(s) End Sub
実行結果
まとめ
使用する文字をShift-JISの範囲内等に限定できるのであれば、
VBA側の型をString型としても、DLLとの文字列の受け渡しは（文字化けせずに）できる。
ただし、その場合は、DLL側で使用する関数が、Unicodeで返す場合とは変わってくる。
DLL側のインターフェイスを、
- VARIANT型
- BSTR型
どちらにするのか、DLLを作る前にきちんと検討、確認をして決めましょう。
Unicode文字をつかうなら、VARIANT一択なんですけど・・・
次回予告
次回こそ、実際に配列の受け渡しをおこないます。
たぶん・・・
