在EXCEL VBA中使用C＃dll
我在这里遇到一个小问题，需要你们的帮助。
我有一个通过COM互操作公开的C＃DLL。 它工作正常，但显然C＃interop对象的部署是一场灾难，每次更新DLL时都需要重新计算。
所以我想知道如何使用这个C＃DLL中的函数，如下所示：或者我可以通过将DLL和电子表格放在一起来调用函数。
Declare Function getString Lib "" () as string sub test() range("A1").value = getString End Sub 语法可能有误。
您可以这样做，但您必须了解VBA和.Net的差异。
首先，您必须创建一个实际的DLL（.Net程序集不是），为此，使用此项目模板 。 然后，你必须知道如何编组东西。
VBA仅支持stdcall作为调用约定，它不能真正处理DLL函数的Unicode。 这本身并不错，因为.Net中String的默认封送是VBA所期望的（指向Ansi char的指针）。 此外，stdcall是我用于导出的默认调用约定。
我将重用我最近为另一个SO线程创建的示例：
把它放在你使用我的模板创建的项目中：
[ComVisible(true), ClassInterface(ClassInterfaceType.AutoDual)] public class Sample { public string Text { [return: MarshalAs(UnmanagedType.BStr)] get; [param: MarshalAs(UnmanagedType.BStr)] set; } [return: MarshalAs(UnmanagedType.BStr)] public string TestMethod() { return Text + "..."; } } static class UnmanagedExports { [DllExport] [return: MarshalAs(UnmanagedType.IDispatch)] static Object CreateDotNetObject(String text) { return new Sample { Text = text }; } }
这是如何从VBA调用它：
Declare Function CreateDotNetObject Lib "The full path to your assembly or just the assembly if it is accessible from Excel" _ (ByVal text As String) As Object Sub test() Dim instance As Object Set instance = CreateDotNetObject("Test 1") Debug.Print instance.Text Debug.Print instance.TestMethod instance.text = "abc 123" ' case insensitivity in VBA works as expected' Debug.Print instance.Text End Sub
这些是使用语句放在类的顶部，这是关键：
使用System.Diagnostics; 使用RGiesecke.DllExport;
还要确保在Nuget PM语句之前启动项目以安装上面的模板。 我是新手 – 我相信还有其他人。 我正在使用AutoCAD VBA并且因为它是64位而得到了另一个错误 – 我必须在Declare语句中使用PtrSafe（etc）来继续VBA（请参阅此文档http://support.microsoft.com/kb） / 983043 ）
它工作顺便说一句！
我的最终代码（基于以上内容）
using System; using System.Collections.Generic; using System.Linq; using System.Text; using System.Runtime.InteropServices; using System.Diagnostics; using RGiesecke.DllExport; namespace ClassLibrary3 { [ComVisible(true), ClassInterface(ClassInterfaceType.AutoDual)] public class Class1 { public string Text { [return: MarshalAs(UnmanagedType.BStr)] get; [param: MarshalAs(UnmanagedType.BStr)] set; } [return: MarshalAs(UnmanagedType.BStr)] public string TestMethod() { return Text + "..."; } } static class UnmanagedExports { [DllExport] [return: MarshalAs(UnmanagedType.IDispatch)] static Object CreateDotNetObject(String text) { return new Class1 { Text = text }; } } }
和我的vba代码：
#If VBA7 Then Private Declare PtrSafe Function CreateDotNetObject Lib "G:\gitRepository\VS\ClassLibrary3\ClassLibrary3\bin\Debug\ClassLibrary3.dll" (ByVal text As String) As Object #Else Private Declare Function CreateDotNetObject Lib "G:\gitRepository\VS\ClassLibrary3\ClassLibrary3\bin\Debug\ClassLibrary3.dll" (ByVal text As String) As Object #End If Sub test() Dim instance As Object Set instance = CreateDotNetObject("Test 1") Debug.Print instance.text Debug.Print instance.TestMethod instance.text = "abc 123" ' case insensitivity in VBA works as expected' Debug.Print instance.text End Sub
我有很多次这个问题。 我最后使用shell和wait方法从vba注册com dll，在regasm util上注册/取消注册dll，然后通过后期绑定创建com对象
CreateObject('yourclasshere')
它有点像黑客但它的工作原理，inheritance了shellandwait方法以及随后的寄存器和取消注册方法。
Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Private Const STATUS_PENDING = &H103& Private Const PROCESS_QUERY_INFORMATION = &H400 Private Function ShellandWait(ExeFullPath As String, _ Optional TimeOutValue As Long = 0) As Boolean Dim lInst As Long Dim lStart As Long Dim lTimeToQuit As Long Dim sExeName As String Dim lProcessId As Long Dim lExitCode As Long Dim bPastMidnight As Boolean On Error GoTo ErrorHandler lStart = CLng(Timer) sExeName = ExeFullPath 'Deal with timeout being reset at Midnight If TimeOutValue > 0 Then If lStart + TimeOutValue < 86400 Then lTimeToQuit = lStart + TimeOutValue Else lTimeToQuit = (lStart - 86400) + TimeOutValue bPastMidnight = True End If End If lInst = Shell(sExeName, vbHide) lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst) Do Call GetExitCodeProcess(lProcessId, lExitCode) DoEvents If TimeOutValue And Timer > lTimeToQuit Then If bPastMidnight Then If Timer < lStart Then Exit Do Else Exit Do End If End If Loop While lExitCode = STATUS_PENDING ShellandWait = True Exit Function ErrorHandler: ShellandWait = False End Function Private Function RegisterPayload() As Boolean Dim script As String script = "cmd /c" script = script + " " + "%windir%\Microsoft.NET\Framework\v2.0.50727\regasm" script = script + " " + Chr(34) + InstallationPath + Chr(34) script = script + " /codebase" RegisterPayload = ShellandWait(script) End Function Private Function UnRegisterPayload() As Boolean Dim script As String script = "cmd /c" script = script + " " + "%windir%\Microsoft.NET\Framework\v2.0.50727\regasm" script = script + " " + Chr(34) + InstallationPath + Chr(34) script = script + " /u" UnRegisterPayload = ShellandWait(script) End Function
希望能帮助到你 ：）