Как вставить строку разрыва во всплывающем окне 'mshta.exe' (макрос VBA)? - PullRequest
0 голосов
/ 18 января 2019

Мне нужно msgbox, который не останавливает макрос.Есть ли способ вставить строку разрыва, такую ​​же как 'vbNewLine' для msgbox?

Ни одна из этих работ:

Chr(13) 
Chr(10)
vbLf 
vbCr 
vbCrLf 
vbNewLine
"<br>"
Function mshta(ByVal MessageText As String, Optional ByVal Title As String, Optional ByVal PauseTimeSeconds As Integer)
'mshta.exe as an alternative for msgbox

'[...] some other stuff

Dim ConfigString As String
Set WScriptShell = CreateObject("WScript.Shell")

ConfigString = "mshta.exe vbscript:close(CreateObject(""WScript.Shell"")." & "Popup(""" & MessageText & """," & PauseTimeSeconds & ",""" & Title & """))"
WScriptShell.Run ConfigString

End Function

Если я вызываю функцию:

mshta "Hello<magic?>World"

Я хочу отобразить:

Hello
World

1 Ответ

0 голосов
/ 15 августа 2019

Вот решение, которое поддерживает возврат каретки, которое использует вызов API вместо WScript.Shell и работает в Excel VBA. Он поддерживает стандартные перечисляемые параметры, такие как vbQuestion + vbYesNo, и может возвращать ответ пользователя. 32000 возвращается, если истекло время ожидания.

Это также имеет то преимущество, что вместо основного дисплея всплывающее окно отображается на том же мониторе, что и приложение.

' This part needs to be at the top of a VBA module
#If Win64 Then 
    Private Declare PtrSafe Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As LongPtr, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#Else
    Private Declare Function MsgBoxTimeout _
        Lib "user32" _
        Alias "MessageBoxTimeoutA" ( _
            ByVal hwnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As VbMsgBoxStyle, _
            ByVal wlange As Long, _
            ByVal dwTimeout As Long) _
    As Long
#End If


Sub TestMsgbox()
    Dim ReturnValue

    ReturnValue = MsgBoxTimeout(0, "Do you like this message?" & vbCrLf & "This message box will be closed after 4 seconds." & vbCrLf & vbCrLf & "(See Immediate window for return value)", "Return Choice", vbQuestion + vbYesNoCancel, 0, 4000)
    Select Case ReturnValue
        Case vbYes
            Debug.Print "You picked Yes."
        Case vbNo
            Debug.Print "You picked No."
        Case vbCancel
            Debug.Print "You picked Cancel."
        Case 32000
            Debug.Print "Timeout before user made selection."
    End Select
End Sub

Дополнительная информация: https://www.extendoffice.com/documents/excel/3836-excel-message-box-timer-timeout.html

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...