文書の過去の版を表示しています。

vb2clr

Excelから.NET Framework 4.xの機能を使用できるツール
https://github.com/jet2jet/vb2clr

使い方

https://github.com/jet2jet/vb2clr からZipファイルを取得し展開する。

ExitHandler.bas と CLRHost.cls ファイルをプロジェクトにドラッグ＆ドロップする。

補足

vb2clrは日本人の方が開発しており、ソース内コメントなどがShift-JISで扱われている。
そのため、海外向けに日本コメントを除去したファイルが用意されている。

ExitHandler.utf8.bas
CLRHost.utf8.cls

参照設定

「Common Runtime Language Execution Engine」と「mscorlib.dll」を参照する。

サンプル

https://club.excelhome.net/thread-1692104-1-1.html

StringBuilderのテスト

Sub StringbuildTest()
    Dim host As New CLRHost
 
    Call host.Initialize(False)
 
    Dim Assem As mscorlib.Assembly, sb As mscorlib.Object, r As Variant
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
 
    Set sb = host.ToObject(host.CLRCreateObject("System.Text.StringBuilder"))
    Set sb = host.CLRInvokeMethod(sb, "Append", "The quick brown fox jumped over the lazy dog. ")
    Set sb = host.CLRInvokeMethod(sb, "Append", "Mary had a little lamb.")
 
    Debug.Print host.CLRProperty(sb, "Length")
    r = host.CLRInvokeMethod(sb, "ToString")
    Debug.Print r
 
    Set sb = Nothing
    Set host = Nothing
End Sub

SortedListとArrayListのテスト

Sub SortedlistTest()
    Dim host As New CLRHost
 
    Call host.Initialize(False)
 
    Dim Assem As mscorlib.Assembly, mySL As Object, Total%, i%, aList As Object, interfacelist As Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set Assem = host.CLRLoadAssembly("System.Collections, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    Set mySL = host.ToObject(host.CLRCreateObject("System.Collections.SortedList"))
 
    mySL.Add "Third", "!"
    mySL.Add "Second", "World"
    mySL.Add "First", "Hello"
 
    Total = mySL.Count
    Debug.Print "番号：", Total
 
    For i = 0 To Total - 1
        Debug.Print mySL.GetKey(i), mySL.GetByIndex(i)
    Next
 
    Set mySL = Nothing
    Stop
 
    Set aList = host.ToObject(host.CLRCreateObject("System.Collections.ArrayList"))
    aList.Add ("Hello")
    aList.Add ("World")
    aList.Add ("!")
 
    For Each key In aList
        Debug.Print key
    Next key
 
    Debug.Print aList.IndexOf("!", 0)
    Set aList = Nothing
    Set host = Nothing
End Sub

乱数テスト

Sub RandomTest()
    Dim host As New CLRHost, dic As Object, s As Long, key As Variant
    Dim objRandom As mscorlib.Object, asmSys As mscorlib.Assembly
 
    Call host.Initialize(False)
    Set dic = CreateObject("scripting.dictionary")
    Set asmSys = host.CLRLoadAssembly("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    Set objRandom = host.CLRCreateObject("System.Random")
 
    ' 使用「System.Random.Next(Int32, Int32)」
    ' 10個の重複しない乱数を生成する
    Do
        s = host.CLRInvokeMethod(objRandom, "Next")
        If Not dic.Exists(s) Then dic.Add s, ""
    Loop Until dic.Count >= 10
 
    ' 乱数の出力
    For Each key In dic.Keys
        Debug.Print key
    Next key
 
    Set dic = Nothing
    Set objRandom = Nothing
    Set host = Nothing
End Sub

テキストファイルの書込み

Sub filetext() 
    ' テキストを書く
    Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, createText$
    Call host.Initialize(False)
 
    'On Error Resume Next
 
    Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, writer As mscorlib.Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
 
    Set SW = host.CLRResolveType("System.IO.Stream")
    Set Encoding = host.CLRResolveType("System.Text.Encoding")
    Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)
 
    ' ※Excel ファイルが配置されているパス フォルダーは CDriveDirs.txt ファイルを生成し、BOM 付きの utf8 テキストを書き込みます。
    textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
    Set writer = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamWriter", False, _
    BindingFlags_Instance Or BindingFlags_Public Or BindingFlags_CreateInstance, Nothing, Array(textPath, False, utf8), Nothing, Array())
 
    ' 書き込むメッセージ
    createText = "Hello and Welcome, 温かい歓迎"
    host.CLRInvokeMethod writer, "Write", createText
    host.CLRInvokeMethod writer, "Close"
 
    Set SW = Nothing
    Set writer = Nothing
    Set Encoding = Nothing
    Set utf8 = Nothing
    Set host = Nothing
End Sub

テキストファイルの読込み

Sub filetextReader() 
    ' テキストを読む
    Dim host As New CLRHost, Encoding As mscorlib.Object, utf8 As mscorlib.Object, textPath$, readText$
 
    Call host.Initialize(False)
 
    'On Error Resume Next
 
    Dim asmSys As mscorlib.Assembly, SW As mscorlib.Object, reader As mscorlib.Object
    host.CLRLoadAssembly ("System, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
    host.CLRLoadAssembly ("System.IO, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    host.CLRLoadAssembly ("System.Text.Encoding, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
 
    textPath = ThisWorkbook.Path & "\CDriveDirs.txt"
    If Len(Dir(textPath)) = 0 Then MsgBox "上記のテキスト書き込み操作を実行し、その後テキストを読み取ります": GoTo label:
 
    Set SW = host.CLRResolveType("System.IO.Stream")
    Set Encoding = host.CLRResolveType("System.Text.Encoding")
    Set utf8 = host.CLRInvokeMethod(host.CLRInvokeMethod(Encoding, "GetProperty", "UTF8"), "GetValue", Null)
    Set reader = host.ToObject(host.CLRGetType(SW).Assembly).CreateInstance_3("System.IO.StreamReader", False, _
    BindingFlags_Public Or BindingFlags_Instance Or BindingFlags_CreateInstance, Nothing, Array(textPath, utf8), Nothing, Array())
 
    readText = host.CLRInvokeMethod(reader, "ReadToEnd")
    host.CLRInvokeMethod reader, "Close"
 
    Debug.Print readText
 
label:
    Set SW = Nothing
    Set reader = Nothing
    Set Encoding = Nothing
    Set utf8 = Nothing
    Set host = Nothing
End Sub

emfファイルをpngファイルに変換

Sub test1()
   ' emfファイルは「拡張メタファイル」と呼ばれる形式です。
   ' Windows のドロー形式（図形の集合で表す）の画像で、一般に引き伸ばしても粗くなりません。
    Dim host As New CLRHost, inputFile$, outputFile$
 
    Call host.Initialize(False)
    inputFile = ThisWorkbook.Path & "\1.emf"
    outputFile = ThisWorkbook.Path & "\1.png"
 
    On Error Resume Next
 
    Dim asmSys As mscorlib.Assembly
    Set asmSys = host.CLRLoadAssembly("System.Drawing, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a")
    Dim imgclass As mscorlib.Object, img As mscorlib.Object, fmt As mscorlib.Object, png As mscorlib.Object
    Set imgclass = host.CLRResolveType("System.Drawing.Image")
 
    ' emfファイルの高さと幅を出力
    Set img = host.CLRInvokeStaticMethod(imgclass, "FromFile", inputFile)
    Debug.Print "ピクチャの高さ: "; host.CLRProperty(img, "Height"); "ピクチャの幅:"; host.CLRProperty(img, "Width")
 
    ' emfファイルをpngファイルに変換して保存する
    Set fmt = host.CLRResolveType("System.Drawing.Imaging.ImageFormat")
    Set png = host.CLRInvokeMethod(host.CLRInvokeMethod(fmt, "GetProperty", "Png"), "GetValue", Null)
    host.CLRInvokeMethod img, "Save", outputFile, png
 
    Set imgclass = Nothing
    Set img = Nothing
    Set fmt = Nothing
    Set png = Nothing
    Set host = Nothing
End Sub

ZIP内のファイル一覧取得

<code vb> Sub ZIPList()

  ' 圧縮パッケージリストを取得する
  ' System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089

  Dim host As New CLRHost, zipfilepath As String
  Call host.Initialize(False)

  'On Error Resume Next

  Dim asmSys As mscorlib.Assembly, ZipFile As mscorlib.Object, archive As mscorlib.Object, Entries As Variant, entry As Variant
  Set asmSys = host.CLRLoadAssembly("System.IO.Compression.FileSystem, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
  Set ZipFile = host.CLRResolveType("System.IO.Compression.ZipFile")

  ' zipファイルの存在確認
  zipfilepath = "C:\Users\Administrator\Downloads\Compressed\pcre2-10.43.zip"
  If Len(Dir(zipfilepath)) = 0 Then MsgBox "パス内のzipファイルが存在しません": Exit Sub

  ' zipファイルの読込み
  Set archive = host.CLRInvokeStaticMethod(ZipFile, "OpenRead", zipfilepath)
  Set Entries = host.ToEnumerable(host.CLRProperty(archive, "Entries"))
  For Each entry In Entries
      ' zipファイル内の各ファイルのフルパス名を出力
      Debug.Print host.CLRProperty(entry, "FullName")
  Next

  Set archive = Nothing
  Set ZipFile = Nothing
  Set host = Nothing

End Sub

八寿のナレッジベース

目次