在VBA中尝试创build无模式对话框时使用CreateDialog

我想在VBA 7.0中创build一个无模式的popup对话框。 到目前为止，最有希望的路线似乎是CreateDialog 。

首先，我尝试CreateDialogW并收到Entry point not found for CreateDialogW in DLL 。
打开DLL后，我validation了这个function没有列出。 上面链接的MSDN引用显示User32作为此函数的DLL，并列出函数名称CreateDialogW和CreateDialogA （分别为Unicode / ansi），但它们不在我的计算机（Win 7专业版，64位）上的此DLL中列出。

因此，查看DLL中的函数列表，我看到了CreateDialogParam和CreateDialogIndirectParam函数 （每个函数的 Ansi和Unicode版本）。

我一直在试图遵循MSDN，并将C例子转换为VB，但是我错过了一些地方，我有点卡住，因为我不知道我做错了什么。 代码编译和运行没有错误，但没有发生在API调用 – 它执行但没有任何反应。

如果有人能给我一些正确的方向，我将不胜感激。 我目前的解决办法很糟糕，我真的想把这个项目button。

 Option Explicit 'Reference conversion of C to VB type declarations here 'http://msdn.microsoft.com/en-us/library/aa261773(v=vs.60).aspx 'Declare function to Win API CreateDialog function 'http://msdn.microsoft.com/en-us/library/ms645434(v=vs.85).aspx Private Declare PtrSafe Function CreateDialog Lib "User32.dll" Alias "CreateDialogParamW" _ (ByVal lpTemplateName As LongPtr, _ ByRef lpDialogFunc As DIALOGPROC, _ ByVal dwInitParam As Long, _ Optional ByVal hInstance As Long, _ Optional ByVal hWndParent As Long) _ As Long 'Windows Style Constants 'http://msdn.microsoft.com/en-us/library/windows/desktop/ms632600(v=vs.85).aspx Public Const WS_BORDER As Long = &H800000 Public Const WS_CAPTION As Long = &HC00000 Public Const WS_CHILD As Long = &H40000000 Public Const WS_CHILDWINDOW As Long = &H40000000 Public Const WS_CLIPCHILDREN As Long = &H2000000 Public Const WS_CLIPSIBLINGS As Long = &H4000000 Public Const WS_DISABLED As Long = &H8000000 Public Const WS_DLGFRAME As Long = &H400000 Public Const WS_GROUP As Long = &H20000 Public Const WS_HSCROLL As Long = &H100000 Public Const WS_ICONIC As Long = &H20000000 Public Const WS_MAXIMIZE As Long = &H1000000 Public Const WS_MAXIMIZEBOX As Long = &H10000 Public Const WS_MINIMIZE As Long = &H20000000 Public Const WS_MINIMIZEBOX As Long = &H20000 Public Const WS_OVERLAPPED As Long = &H0 Public Const WS_POPUP As Long = &H80000000 Public Const WS_SIZEBOX As Long = &H40000 Public Const WS_SYSMENU As Long = &H80000 Public Const WS_TABSTOP As Long = &H10000 Public Const WS_THICKFRAME As Long = &H40000 Public Const WS_TILED As Long = &H0 Public Const WS_VISIBLE As Long = &H10000000 Public Const WS_VSCROLL As Long = &H200000 Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED + WS_CAPTION + WS_SYSMENU + WS_THICKFRAME + WS_MINIMIZEBOX + WS_MAXIMIZEBOX) Public Const WS_TILEDWINDOW As Long = (WS_OVERLAPPED + WS_CAPTION + WS_SYSMENU + WS_THICKFRAME + WS_MINIMIZEBOX + WS_MAXIMIZEBOX) Public Const WS_POPUPWINDOW As Long = (WS_POPUP + WS_BORDER + WS_SYSMENU) 'Declare custom type for lpDialogFunc argument 'http://msdn.microsoft.com/en-us/library/windows/desktop/ms645469(v=vs.85).aspx Public Type DIALOGPROC hwndDlg As Long uMsg As LongPtr wparam As Long lparam As Long End Type 'MAKEINTRESOURCE Macro emulation 'http://msdn.microsoft.com/en-us/library/windows/desktop/ms648029(v=vs.85).aspx 'Bitwise function example found here: http://support.microsoft.com/kb/112651 'VB conversion found here: https://groups.google.com/forum/#!topic/microsoft.public.vb.winapi/UaK3S-bJaiQ _ modified with strong typing and to use string pointers for VB7 Private Function MAKEINTRESOURCE(ByVal lID As Long) As LongPtr MAKEINTRESOURCE = StrPtr("#" & CStr(MAKELONG(lID, 0))) End Function Private Function MAKELONG(ByRef wLow As Long, ByRef wHi As Long) 'Declare variables Dim LoLO As Long Dim HiLO As Long Dim LoHI As Long Dim HiHI As Long 'Get the HIGH and LOW order words from the long integer value GetHiLoWord wLow, LoLO, HiLO GetHiLoWord wHi, LoHI, HiHI If (wHi And &H8000&) Then MAKELONG = (((wHi And &H7FFF&) * 65536) Or (wLow And &HFFFF&)) Or &H80000000 Else MAKELONG = LoLO Or (&H10000 * LoHI) 'MAKELONG = ((wHi * 65535) + wLow) End If End Function Private Function GetHiLoWord(lparam As Long, LOWORD As Long, HIWORD As Long) 'This is the LOWORD of the lParam: LOWORD = lparam And &HFFFF& 'LOWORD now equals 65,535 or &HFFFF 'This is the HIWORD of the lParam: HIWORD = lparam \ &H10000 And &HFFFF& 'HIWORD now equals 30,583 or &H7777 GetHiLoWord = 1 End Function Public Function TstDialog() Dim dpDialog As DIALOGPROC dpDialog.hwndDlg = 0 dpDialog.uMsg = StrPtr("TEST") dpDialog.lparam = 0 dpDialog.wparam = 0 CreateDialog hInstance:=0, lpTemplateName:=MAKEINTRESOURCE(WS_POPUPWINDOW + WS_VISIBLE), lpDialogFunc:=dpDialog, dwInitParam:=&H110 End Function 

Answer 1

这可以工作，但如果你应该尝试使其工作是另一个问题。 我有一个工作版本，显示一个空的对话框。 今晚我没有更多的时间来完成对话的实际控制，但是我希望能够让你开始。

首先，您需要忘记CreateDialog，因为它们需要将对话框模板放在资源部分。 您可以使用CreateDialogIndirectParam从内存中的对话框模板创build一个对话框。 你将需要这个：

 Private Type DLGTEMPLATE style As Long dwExtendedStyle As Long cdit As Integer x As Integer y As Integer cx As Integer cy As Integer End Type Private Type DLGITEMTEMPLATE style As Long dwExtendedStyle As Long x As Integer y As Integer cx As Integer cy As Integer id As Integer End Type Private Type DLG dlgtemp As dlgtemplate menu As Long classname As String title As String End Type Private Declare PtrSafe Function CreateDialogIndirectParam Lib "User32.dll" Alias "CreateDialogIndirectParamW" _ (ByVal hInstance As Long, _ ByRef lpTemplate As DLGTEMPLATE, _ ByVal hWndParent As Long, _ ByVal lpDialogFunc As LongPtr, _ ByVal lParamInit As Long) _ As LongPtr Const WM_INITDIALOG As Long = &H110 Const DS_CENTER As Long = &H800& Const DS_SETFONT As Long = &H40 Const DS_MODALFRAME As Long = &H80 Const WS_EX_APPWINDOW As Long = &H40000 

然后像这样调用它：

 Dim d As DLG d.dlgtemp.style = DS_MODALFRAME + WS_POPUP + WS_VISIBLE + WS_CAPTION + WS_SYSMENU d.dlgtemp.dwExtendedStyle = WS_EX_APPWINDOW d.dlgtemp.cdit = 0 d.dlgtemp.x = 100 d.dlgtemp.y = 100 d.dlgtemp.cx = 200 d.dlgtemp.cy = 200 d.menu = 0 d.title = "Test" d.classname = "Test" CreateDialogIndirectParam 0, d.dlgtemp, 0, AddressOf DlgFunc, 0 

与DlgFunc看起来像这样：

 Public Function DlgFunc(ByVal hwndDlg As LongPtr, ByVal uMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr If uMsg = h110 Then ' = WM_INITDIALOG - you should make a const for the various window messages you'll need... DlgFunc = True Else DlgFunc = False End If End Function 

自从我上一次做这些事情已经过去了十年。 但是，如果你决定走这条路线，我认为这种方法是最有前途的 – 下一步是调整DLG结构来添加一些DLGITEMTEMPLATE成员，将d.dlgtemp.cdit设置为对话框上控件的数量，并开始在您的DlgFunc中处理控制消息。

Answer 2

我不想从深入的angular度进行深入研究，但是可以在VBA中dynamic创build无模式的对话框。 这个问题在提问者勇敢地用CreateDialog潜入兔子洞之前是最初的问题。 所以这个答案是针对在VBA中dynamic创build无模式对话框的原始问题，而不是如何使用CreateDialog 。 我无法帮到那里。

如前所述，可以使用UserForm创build非modal dialog，但是我们不希望丢弃项目的无用forms。 我已经实现的解决方法使用了Microsoft VBA可扩展性库。 简而言之，我们创build一个类，在构造项目中添加一个通用的用户窗体，并在终止时删除用户窗体。

还要注意，这是使用Excel VBA进行testing的。 我没有SolidWorks，所以我不能在那里testing。

粗略地做成一个class级模块。

 Option Explicit Private pUserForm As VBIDE.VBComponent Private Sub Class_Initialize() ' Add the userform when created ' Set pUserForm = ThisWorkbook.VBProject.VBComponents.Add(VBIDE.vbext_ct_MSForm) End Sub Private Sub Class_Terminate() ' remove the userform when instance is deleted ' ThisWorkbook.VBProject.VBComponenets.Remove pUserForm End Sub Public Property Get UserForm() As VBIDE.VBComponent ' allow crude access to modify the userform ' ' ideally this will be replaced with more useful methods ' Set UserForm = pUserForm End Property Public Sub Show(ByVal mode As Integer) VBA.UserForms.Add(pUserForm.Name).Show mode End Sub 

理想情况下，这个类会更好地开发，并允许更容易地修改表单，但现在这是一个解决scheme。

testing

 Private Sub TestModelessLocal() Dim localDialog As New Dialog localDialog.UserForm.Properties("Caption") = "Hello World" localDialog.Show vbModeless End Sub 

你应该看到一个窗口出现并消失localDialog离开范围。 一个UserForm1在您的VBProject中创build并删除。

此testing将创build一个持久对话框。 不幸的是， UserForm1将保留在你的VBProject中，因为globalDialog仍然被定义。 重置项目不会删除用户窗体。

 Dim globalDialog As Dialog Private Sub TestModeless() Set globalDialog = New Dialog globalDialog.UserForm.Properties("Caption") = "Hello World" globalDialog.Show vbModeless 'Set globalDialog = Nothing closes window and removes the userform ' 'Set gloablDialog = new Dialog should delete userform1 after added userform2' End Sub 

所以不要在模块范围使用这个。

总而言之，这是一个丑陋的解决scheme，但它比阿斯克尔试图做的要难得多。

Answer 3

这个项目的开始很糟糕。 你完全dwInitParam了CreateDialogParam参数的顺序，注意hInstance参数是第一个， dwInitParam参数是最后一个。

你完全摸索了DIALOGPROC声明，它是一个函数指针。 当你打电话时，这需要LongPtr中的LongPtr和AddressOf操作符。

这只是使其工作的第一个1％。 接下来的问题是，你将不得不编写一个函数对话过程（ AddressOf的目标）来处理对话生成的通知。 基本的东西，如识别用户点击确定button。 当你对WinAPI编程不够了解的时候很难写，在运行时，一些小的错误是很大的不可知的问题。

这只是小事，还有更大的问题。 lpTemplateName参数是一个非常严重的障碍。 这需要是一个资源标识符，由“rc.exe”生成并由链接器添加到可执行文件中。 您无法重新链接SolidWorks。 无模式对话需要消息循环的帮助，它必须调用IsDialogMessage() 。 您无法说服SolidWorks为您打电话。 如果没有它，对话方式会很难诊断，比如Tab键将不起作用。

你必须知道什么时候你绝对没有机会做到这一点。 你不能使它工作。

Answer 4

像Cheezsteak这样的回答并不直接处理CreateDialog的问题。 它解决了创build无模式对话框的最终目标。

我的build议是使用用户窗体来完成这一点。 它是Show Method的一个可选参数，用于确定用户窗体是否显示为模态或非模态forms。

从MSDN文档：

模态可选。 确定UserForm是模态还是非模态的布尔值。

1. 创build一个用户窗体并根据您的需要进行devise 。

2. 在创buildUserForm实例的代码中，只需将它传递给vbModeless常量即可。

    Option Explicit Private frm As UserForm1 Sub test2() Set frm = New UserForm1 frm.Show vbModeless End Sub 

如果你担心用表格混淆你的项目，不要这样做。 只需创build表单即可 。