VBAでのTaskDialogIndirect

Module1.bas

Option Explicit


Enum ICONS
    TD_WARNING_ICON = 65535
    TD_ERROR_ICON = 65534
    TD_INFORMATION_ICON = 65533
    TD_SHIELD_ICON = 65532
End Enum

Enum TASKDIALOG_FLAGS
    TDF_ENABLE_HYPERLINKS = &H1
    TDF_USE_HICON_MAIN = &H2
    TDF_USE_HICON_FOOTER = &H4
    TDF_ALLOW_DIALOG_CANCELLATION = &H8
    TDF_USE_COMMAND_LINKS = &H10
    TDF_USE_COMMAND_LINKS_NO_ICON = &H20
    TDF_EXPAND_FOOTER_AREA = &H40
    TDF_EXPANDED_BY_DEFAULT = &H80
    TDF_VERIFICATION_FLAG_CHECKED = &H100
    TDF_SHOW_PROGRESS_BAR = &H200
    TDF_SHOW_MARQUEE_PROGRESS_BAR = &H400
    TDF_CALLBACK_TIMER = &H800
    TDF_POSITION_RELATIVE_TO_WINDOW = &H1000
    TDF_RTL_LAYOUT = &H2000
    TDF_NO_DEFAULT_RADIO_BUTTON = &H4000
    TDF_CAN_BE_MINIMIZED = &H8000&
End Enum

Enum TASKDIALOG_COMMON_BUTTON_FLAGS
    TDCBF_OK_BUTTON = &H1
    TDCBF_YES_BUTTON = &H2
    TDCBF_NO_BUTTON = &H4
    TDCBF_CANCEL_BUTTON = &H8
    TDCBF_RETRY_BUTTON = &H10
    TDCBF_CLOSE_BUTTON = &H20
End Enum

Type TASKDIALOG_BUTTON
    nButtonID As Long
    pszButtonText As Long
End Type


Type TASKDIALOGCONFIG
    cbSize As Long
    hwndParent As Long
    hInstance As Long
    dwFlags As TASKDIALOG_FLAGS
    dwCommonButtons As Long
    pszWindowTitle As Long
    pszMainIcon As ICONS
    pszMainInstruction As Long
    pszContent As Long
    cButtons As Long
    pButtons As Long
    nDefaultButton As Long
    cRadioButtons As Long
    pRadioButtons As Long
    nDefaultRadioButton As Long
    pszVerificationText As Long
    pszExpandedInformation As Long
    pszExpandedControlText As Long
    pszCollapsedControlText As Long
    pszFooterIcon As Long
    pszFooter As Long
    pfCallback As Long
    lpCallbackData As Long
    cxWidth As Long
End Type

Declare Function TaskDialogIndirect& Lib "comctl32" _
                                     (ByVal pTaskConfig&, ByVal pnButton&, ByVal pnRadioButton&, ByVal pfVerificationFlagChecked&)
Private Declare PtrSafe Function CreateActCtxW Lib "Kernel32.dll" (pActCtx As Any) As LongPtr


Private Declare PtrSafe Function ActivateActCtx Lib "Kernel32.dll" ( _
        ByVal hActCtx As LongPtr, _
        lpCookie As LongPtr) As Long

Private Declare PtrSafe Function DeactivateActCtx Lib "Kernel32.dll" ( _
        ByVal dwFlags As Long, _
        ByVal ulCookie As LongPtr) As Long
Private cookie As LongPtr


Sub main()

    Dim st As TASKDIALOGCONFIG
    Dim ret&, buttons(0 To 1) As TASKDIALOG_BUTTON

    buttons(0).nButtonID = vbOK
    buttons(0).pszButtonText = StrPtr("ボタン名")

    buttons(1).nButtonID = vbCancel
    buttons(1).pszButtonText = StrPtr("ボタン名２")

    With st
        .cbSize = Len(st)
        .hwndParent = Excel.Application.Hwnd
        .pszWindowTitle = StrPtr("Title")
        .dwFlags = TDF_USE_COMMAND_LINKS
        .pszMainIcon = TD_ERROR_ICON
        .pszMainInstruction = StrPtr("hoge")
        .pszContent = StrPtr("foo")
        .pButtons = VarPtr(buttons(0))
        .cButtons = UBound(buttons) + 1
    End With

    Call hoge2
    TaskDialogIndirect VarPtr(st), VarPtr(ret), 0, 0
    Debug.Print ret
    Call hoge3

End Sub

Sub hoge2()

    Dim st&(0 To 8)
    Dim hAct&

    st(0) = 9 * 4
    st(2) = StrPtr(
    hAct = CreateActCtxW(st(0))

    Dim bret As Long
    bret = ActivateActCtx(hAct, cookie)


End Sub

Sub hoge3()

    DeactivateActCtx 0, cookie

End Sbu