logo标签列表

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

c++vbaapidialogmodeless
34

我想在VBA 7.0中创建一个非模态弹出对话框。 到目前为止，最有希望的途径似乎是使用CreateDialog。

首先我尝试了CreateDialogW，但收到了DLL中找不到CreateDialogW的入口点的错误信息。
打开DLL后，我验证了此函数未列出。上述链接的MSDN参考文献显示User32是此函数的DLL，并列出了函数名称CreateDialogW和CreateDialogA（分别是Unicode / ansi），但它们没有列在我的计算机（Win 7专业版，64位）的此DLL中。

因此，查看DLL中列出的函数列表，我看到了CreateDialogParam和CreateDialogIndirectParam 函数(每个函数都有Ansi和Unicode版本)。

我一直在尝试遵循MSDN并将C示例转换为VB，但我在某个地方遗漏了什么，并且我陷入了困境，因为我不知道我做错了什么。该代码可以编译和运行，但在API调用时什么也不会发生-它执行但没有任何反应。

如果有人能给我指点方向，我将非常感激。 我的当前解决方法很糟糕，我真的想把这个项目完成。

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
2
CreateDialog在其文档中指出它是一个实际使用CreateDialogParam的宏。它还指出它返回一个值，如果该返回值为NULL，则应使用GetLastError查找失败原因。你没有这样做 - 为什么不呢？（不确定为什么你要跳过所有这些步骤;任何支持VBA的Office产品都有更容易使用的内置创建表单（对话框）的方法。） - Ken White
1
Ken，我正在使用带有Solidworks的VBA 7.0。据我所知，除了创建通用表单并调用设置为VbModeless的实例之外，没有任何本地函数可以在VBA中创建无模式对话框。我正在探索Windows API选项，因为我不喜欢在我的项目中有不必要的表单，并且也作为学习/挑战性的经验。 - CBRF23
我应该在哪里使用GetLastError函数？文档指出我应该在VBA中使用err.LastDllError。目前调用该函数时没有任何反应，因此我认为我没有返回值可以检查。 - CBRF23
1
哦，等等。我仔细看了一下你的代码。DIALOGPROC是完全错误的。DIALOGPROC是一个指向函数（DIALOG过程）的指针，它接受参数hwnd, umsg, wParam, lParam - 它不是一个数据结构。你需要传递一个方法的指针，我甚至不确定从VBA是否可能这样做。此外，您还需要预定义的DIALOG资源（使用MS资源编译器编译的资源脚本，并链接到应用程序中），以便使用CreateDialog; 它接收的参数之一是该资源的名称。恐怕你离正确还有很远的距离。 - Ken White
1
糟糕 - 在我放链接之前被分心了。我提到的DialogProc文档。 - Ken White
显示剩余5条评论
4个回答
8

这个可以被解决，不过是否值得去尝试又是另外一个问题。我有一个可以显示空白对话框的可用版本。今晚我没有时间继续添加实际控件到对话框，但我发布帖子是为了让您开始。

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

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 中处理控件消息。

1
此外，如果你真的要做这个的话，建议你阅读这个系列文章：http://blogs.msdn.com/b/oldnewthing/archive/2005/04/29/412577.aspx。 - Roel
2
我可以验证我有空白的非模态对话框窗口，但是我现在无法关闭它们。关闭Excel时，它们确实会离开。 - cheezsteak
我已将此标记为答案，因为它回答了我最初的问题 - 它使我能够使用 API 调用创建无模态对话框，这正是我想做的。现在我必须决定是否这是最佳路径，还是选择另一种替代方案。为此，这里提供了许多选项，似乎比我最初知道的要多得多 - 所以我在这里获得了很多有用的信息。感谢大家！ - CBRF23
如果您决定走这条路，我认为最简单的方法是在VBA中重新实现CDlgTempl（来自http://support.microsoft.com/kb/155257/en-us/），包括使用HeapAlloc / HeapFree调用来替代VBA中缺少的malloc（）函数。内存对齐仍然是一个问题，但我想并非无法解决。在VBA中实现正确处理所有这些的类/模块将会很棘手，但比MFC中支持对话框所做的工作要复杂得多。而且它仍然会让您拥有一种非常繁琐（没有UI设计器）的方式来实现对话框。 - Roel
@Roel 我最初的计划是创建一个类模块，可以在多个项目中使用（我仍在为VBA源代码寻找良好的分发方法 - 我之前找到了一个看起来不错的解决方案，但现在找不到链接了 - 我在办公室有书签）。我已经为一些API调用“包装器”创建了类对象，例如BrowseForFolder、GetOpenFileName等，在SW VSTA套件中没有本地支持，但我在很多项目中使用。我从未想过这次尝试会如此复杂。仍然是一个非常好的学习经验！ - CBRF23
显示剩余2条评论
8
我不想贬低深入研究的内容，但在VBA中动态创建无模式对话框存在可能的解决方法。这是在提问者勇敢地使用CreateDialog之前的原始问题。因此，这个答案是为了解决VBA中动态创建无模式对话框的原始问题，而不是如何使用CreateDialog。我不能在那里提供帮助。
如先前所述，可以使用UserForm创建无模式对话框，但我们不希望无用的表单混乱项目。我实现的解决方法使用了Microsoft VBA Extensibility Library。简而言之，我们创建一个类，在构造时向项目添加一个通用用户窗体，并在终止时删除该用户窗体。
另请注意，这是使用Excel VBA进行测试的。我没有SolidWorks，所以无法在那里测试它。
作为一个类模块，做得比较粗略。
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

理想情况下，这个类应该更好地开发，并允许更容易地访问修改表单，但现在它是一个解决方案。
测试
Private Sub TestModelessLocal()

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

End Sub

当localDialog超出作用域时，您会看到一个窗口出现并消失。在您的VBProject中创建了一个UserForm1并将其删除。

此测试将创建一个持久性对话框。不幸的是，由于globalDialog仍然被定义，因此UserForm1将保留在您的VBProject中。重置项目将无法删除用户窗体。

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

因此，永远不要在模块作用域中使用它。

总之，这是一个丑陋的解决方案，但比提问者尝试做的事情要好得多。

嗨，cheezsteak，是的，动态添加表单是一种选择。我不喜欢动态修改VBA项目的唯一一件事是，它使得调试变得非常麻烦，因为一旦项目在程序上被修改，就不再可能暂停执行，代码必须运行到完成。这对我来说意味着我必须在我的代码中进行大量的错误检查和打印到调试窗口，或者存储结果并在最后打印到消息框中，在VBA中有点麻烦，因为没有像.net那样的try/catch :/ 这也是我考虑其他方法的原因之一，但这是一个选择！ - CBRF23
@CBRF23你不能暂停执行吗？我可以顺利地通过上面的代码，但如果您提前退出，用户窗体将不会被删除，这是我所知道的唯一错误。 - cheezsteak
@vba4all 在问题的评论中，提问者表示“我不喜欢在我的项目中有不必要的表单”。据我理解，他想要像使用Msgbox一样动态创建对话框，但是是非模态的。所有产生对话框的内置函数都是模态的。 - cheezsteak
1
这个能用吗？链接 - user2140173
@DavidThomas 我上面的评论是针对这个答案的，使用可扩展性来动态添加用户窗体。Vba4All也提供了一个相当不错的解决方案，这是使用Windows API的一个可行替代方法。在我的项目中，我肯定会考虑这个解决方案 - 它看起来简单，并且可以很容易地适应包装函数中。我选择了我选择的答案，因为它回答了我原始问题中的所有内容，但就解决方案而言 - 我认为Vba4All的可能是最容易实现的。 - CBRF23
显示剩余7条评论
4
你在这个项目的开端就犯了很多错误。你完全颠倒了CreateDialogParam函数的参数顺序，需要注意hInstance参数应该放在第一位，dwInitParam参数应该放在最后。
你完全搞错了DIALOGPROC声明，它是一个函数指针。这要求在声明中使用LongPtr，并在调用时使用AddressOf操作符。
这只是让它工作的第1%。下一个问题是你将不得不编写一个能够处理对话框生成的通知的功能性对话框过程（即AddressOf的目标）。基本的东西，比如识别用户点击了确定按钮。如果你对WinAPI编程不够了解，那么编写起来非常困难，小错误在运行时会成为大问题，难以诊断。
那只是小问题，还有更大的问题。lpTemplateName参数是一个非常严重的障碍。这需要是一个资源标识符，由“rc.exe”生成并由链接器添加到可执行文件中。您无法重新链接SolidWorks。无模式对话框需要来自消息循环的帮助，它必须调用IsDialogMessage()。您无法说服SolidWorks为您进行此调用。如果没有它，对话框会以难以诊断的方式出现问题，例如制表符将无法工作。
您必须知道什么时候绝对没有机会使其工作。您不能使其工作。
非常感谢您提供的专业反馈。我最初按照MSDN文档的顺序设置了CreateDialogParam参数，但不幸的是，VBA要求可选参数必须放在最后，这就是它们现在的排序方式。我不知道这是否会影响API调用。听起来确实如此。正如上面的Ken指出的那样，我完全误解了如何使用DialogProc回调函数 - 但我找到了一些关于使用AddressOf的信息。看起来这在VBA中是行不通的，或者至少不值得花费时间和精力。 - CBRF23
我无法决定我的评论是放在这里还是你的Tumbleweed问题中。- randy很明显，你已经对这个问题和问题进行了相当多的思考。我的唯一建议（如果可能的话）是将代码精简到最小。这将使人们更容易看到代码以及可能出错的地方。也许可以独立验证实用函数是否正确，比如MAKELONG。祝你好运！ - Randy Stegbauer
4
这个答案，就像Cheezsteak一样，没有直接解决你在CreateDialog方面遇到的问题。它解决了创建无模式对话框的最终目标。
我的建议是使用UserForm来实现这个目标。它的Show Method需要一个可选参数，用于确定用户窗体是以模态还是非模态形式显示。
从MSDN文档中可以看到：

modal Optional. Boolean value that determines if the UserForm is modal or modeless.

  1. Create a UserForm and design it to your needs.

  2. In the code that creates the instance of the UserForm, simply pass it the vbModeless constant.

    Option Explicit

Private frm As UserForm1

Sub test2()
    Set frm = New UserForm1
    frm.Show vbModeless
End Sub
如果你担心在项目中添加表单会使其混乱，那就不用担心。只需动态创建表单即可。
1
我在我的回答中引用了相关的问题链接。 - cheezsteak
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接