vba - MsgBox 对于文本来说不够大

Question

我有一个字符串（msg），它几乎是一个很长的项目列表。我需要把它放在一个 msgbox 中，但它不足以显示整个文本。有没有替代方案？

谢谢！

score 8 · Accepted Answer

消息框函数是 VBA 的内置函数，不能超过 1024 个字符。您仅限于创建自己的用户窗体或其他替代方法...例如打开并写入未保存的记事本实例...

用于打开记事本并向其写入消息的 ALL API 解决方案... 注意：如果您正在运行 VBA 7.0 (Office 2010)，那么您必须在每个 Declare 语句之后添加 PtrSafe...

在模块顶部粘贴 API 声明和全局变量

Option Explicit

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Public Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

'Miscellaneous API Constants
Public Const NORMAL_PRIORITY_CLASS As Long = &H20&
Public Const INFINITE As Long = -1&

'Window Message Constants
Public Const WM_GETTEXT = &HD
Public Const WM_GETTEXTLENGTH = &HE
Public Const WM_SETTEXT As Long = &HC

'GetWindow Constants
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4

'Keybd_event Constants
Public Enum enumKBE
     KBE_KeyDown = 0
     KBE_KeyUp = 2
     KBE_ExtKeyDown = 1
     KBE_ExtKeyUp = 3
End Enum

'Keyboard Control Key Constants
Public Const VK_CONTROL = &H11
Public Const VK_HOME = &H24

'Keyboard Control Action Constants
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101

'Create a new process
Public Declare Function CreateProcessA _
    Lib "kernel32.dll" _
      (ByVal lpApplicationName As String, _
       ByVal lpCommandLine As String, _
       ByVal lpProcessAttributes As Long, _
       ByVal lpThreadAttributes As Long, _
       ByVal bInheritHandles As Long, _
       ByVal dwCreationFlags As Long, _
       ByVal lpEnvironment As Long, _
       ByVal lpCurrentDirectory As String, _
       ByRef lpStartupInfo As STARTUPINFO, _
       ByRef lpProcessInformation As PROCESS_INFORMATION) As Long

'Waits until the specified process has finished processing its initial input
'and is waiting for user input with no input pending, or until the time-out
'interval has elapsed.
Public Declare Function WaitForInputIdle _
    Lib "user32.dll" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long

'Closes Handles Created and referenced from the CreateProcess API
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

'Returns the Window Handle of the Window that is accepting User input.
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long

'Desktop Window handle
Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long

'Retrieves Window handle
Public Declare Function GetWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

'Get the length of a Window's caption
Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

'Get the caption of a Window as a string
Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
      (ByVal hwnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

'Returns the Class or catagory name of an Window handle
Public Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" _
        (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

'You can use the GetDlgItem function with any parent-child window pair, not just with
'dialog boxes. As long as the hDlg (hWnd) parameter specifies a parent window and the
'child window has a unique identifier (as specified by the hMenu parameter in the
'CreateWindow  or CreateWindowEx  function that created the child window),
'GetDlgItem returns a valid handle to the child window.
Public Declare Function GetDlgItem Lib "user32.dll" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

'Send messages to windows
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

'Finds a window with the name, returns the handle.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Gets a controls window handle. The form window handle must be specified to get a decent control.
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

'Translates (maps) a virtual-key code into a scan code or character value
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

'Synthesizes a keystroke. The system can use such a synthesized keystroke to generate a WM_KEYUP or WM_KEYDOWN message.
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'Sets Keyboard control and focus to the provided Window handle
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'Computer will wait for x number of milliseconds

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Write2Notepad 函数打开一个新的记事本实例并写入它。如果成功，那么它将返回记事本实例的进程 ID。

Public Function Write2Notepad(strInText As String) As Long
Const nEditID = 15  'Identifier ID to Notepad's Edit Control
Dim PI As PROCESS_INFORMATION
Dim SI As STARTUPINFO
Dim RetVal As Long, hWndNote As Long, chWnd As Long, LngVal As Long, PID As Long
Dim strCaption As String, strClassName As String

'Initialize the STARTUPINFO structure
SI.cb = Len(SI)

'Start the application
RetVal = CreateProcessA(lpApplicationName:=vbNullString, _
    lpCommandLine:="Notepad.exe", _
    lpProcessAttributes:=0&, _
    lpThreadAttributes:=0&, _
    bInheritHandles:=1&, _
    dwCreationFlags:=NORMAL_PRIORITY_CLASS, _
    lpEnvironment:=0&, _
    lpCurrentDirectory:=vbNullString, _
    lpStartupInfo:=SI, _
    lpProcessInformation:=PI)

'Wait for the application to finish loading
While WaitForInputIdle(PI.hProcess, INFINITE) <> 0
    DoEvents
Wend

'Get the Process ID of the newly opened Notepad application
PID = PI.dwProcessID

'Close all Threads and handles for the Startup Process Information
'    (This is not the Window Handle and is highly recommended)
Call CloseHandle(PI.hThread)
Call CloseHandle(PI.hProcess)

'Get the Active Application's Window Handle
  'Note: when stepping through code in debugger this Will Return the VB Editor's Window Handle,
  ' Set a break point below GetForegroundWindow instead.
hWndNote = GetForegroundWindow()
If hWndNote = 0 Then   '
    'If the ForegroundWindow Handle isn't available Get the first Child Window to the Desktop
    hWndNote = GetWindow(GetDesktopWindow, GW_CHILD)
End If
'Do While loop to verify the hWndNote Window Handle belongs to an Empty Untitled Notepad Window
Do
    chWnd = 0
    'Get Window Caption
    LngVal = GetWindowTextLength(hWndNote) + 1
    strCaption = String(LngVal, Chr$(0))
    LngVal = GetWindowText(hWndNote, strCaption, LngVal)
    strCaption = IIf(LngVal > 0, Left(strCaption, LngVal), "")

    'Get the Window Class name
    LngVal = GetWindowTextLength(hWndNote) + 1
    strClassName = String(LngVal, Chr$(0))
    LngVal = GetClassName(hWndNote, strClassName, LngVal)
    strClassName = IIf(LngVal > 0, Left(strClassName, LngVal), "")

    If strCaption Like "Untitled - Notepad" And strClassName = "Notepad" Then
        'Get the window handle of the Edit Control which is a child window of Notepad
        chWnd = GetDlgItem(hWndNote, nEditID)
        'Get the character count of the notepad text to ensure it is empty (Should return 0)
        If SendMessage(chWnd, WM_GETTEXTLENGTH, 0, 0) = 0 Then
            Exit Do
        End If
    End If
    'Get the next Window
    hWndNote = GetWindow(hWndNote, GW_HWNDNEXT)
    'Process Windows events.
    DoEvents
Loop While hWndNote <> 0
If hWndNote = 0 Then
    MsgBox "Cannot find Notepad's Window Handle."
    Write2Notepad = 0
    Exit Function
End If
If chWnd = 0 Then
    'Returns child Window Hwnd - Similar to GetDlgItem
    chWnd = FindWindowEx(hWndNote, ByVal 0&, vbNullString, vbNullString)
End If
DoEvents

'Sends the Text Value to Notepad
RetVal = SendMessage(chWnd, WM_SETTEXT, Len(strInText) + 1, ByVal strInText)

'To ensure the cursor position is at the top left the Keyboard Control forces the "Ctrl" Key is pressed
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KBE_KeyDown, 0
'Sends the "Home" input to Notepad (Simulates the CTRL + Home action to bring the cursor to the top of Notepad
SendMessage chWnd, WM_KEYDOWN, VK_HOME, 0
SendMessage chWnd, WM_KEYUP, VK_HOME, 0
'Simulates the Key up or unpressing of the "Ctrl" Key
keybd_event VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KBE_KeyUp, 0

'Ensures the Notepad window has the Cursor Focus
SetForegroundWindow (hWndNote)

'Returns the Process ID if the Value of the Settext SendMessage call equals a value of 1 (True) = successful
If CBool(RetVal) = True And PID > 0 Then
    Write2Notepad = PID
Else
    Write2Notepad = 0
End If
End Function

测试 Write2Notepad 功能的例程

Sub TestWriting2Notepad()
Dim strTestText As String
Dim lngProcID As Long
Dim oNotepad As Object

strTestText = "This" & vbCrLf & "is" & vbCrLf & "a Test" & vbCrLf & "to see if" & vbCrLf & "I can" & vbCrLf & _
  vbCrLf & vbCrLf & "Write" & vbCrLf & vbCrLf & "2" & vbCrLf & vbCrLf & "Notepad!!!"

lngProcID = Write2Notepad(strTestText)
If lngProcID = 0 Then
    Debug.Print "Something went wrong... It was probably your fault!"
Else
    Debug.Print "You Successfully Wrote to Notepad...  API Style!"
    Do
        DoEvents
        Sleep 500
        Set oNotepad = Nothing
        On Error Resume Next
        Set oNotepad = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & lngProcID & "'")
        On Error GoTo 0
    Loop While Not oNotepad Is Nothing
    ' For Example only - Delete Below Line
    MsgBox "You Closed Notepad"
End If
End Sub

上面的代码可能看起来很麻烦或更复杂，但它可能会比任何其他方法更可靠、更有效地工作。

下面的功能将使用 MS 剪辑工具将您的消息复制到剪贴板，打开记事本，然后将剪贴板内容（您的消息）粘贴到记事本中......这样您就不必将任何内容保存到文件中，而且很容易已关闭...或者您可以选择保存它。

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Print2Notepad(strMessage)
Dim oShell As Object, oExec As Object, oIn As Object
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("clip")
Set oIn = oExec.StdIn
oIn.WriteLine strMessage
oIn.Close
Do While oExec.Status = 0
    Sleep 100
Loop
Set oIn = Nothing
Set oExec = Nothing
oShell.Run "Notepad", 1, False
Sleep 250
oShell.SendKeys "^v"
End Sub

Sub test()
Call Print2Notepad("This is a test message")
End Sub

如果需要，您还可以在记事本打开时向“睡眠”添加一个额外的例程以停止代码......见下文

Sub Print2Notepad_WaitTillClose(strMessage)
Dim oShell As Object, oExec As Object, oIn As Object
Dim iPID As Variant, oNotepad As Object
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("clip")
Set oIn = oExec.StdIn
oIn.WriteLine strMessage
oIn.Close
Do While oExec.Status = 0
    Sleep 100
Loop
Set oIn = Nothing
Set oExec = Nothing
iPID = oShell.Exec("Notepad").ProcessID
Sleep 500
oShell.SendKeys "^v"
Do
    Sleep 500
    Set oNotepad = Nothing
    On Error Resume Next
    Set oNotepad = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & iPID & "'")
    On Error GoTo 0
Loop While Not oNotepad Is Nothing

' For Example only - Delete Below Line
MsgBox "You Closed Notepad"
End Sub

编辑：我刚刚意识到我编写了上面的代码来为 VBScript 工作......因为这是 Excel，如果你想研究其他方法来将内容复制到剪贴板而不使用 WshShell.Exec 方法；你也可以试试：

Dim DataObj As New MSForms.DataObject
Dim S As String
S = "Hello World"
DataObj.SetText S
DataObj.PutInClipboard

要在代码中使用 DataObject，您必须设置对 Microsoft Forms 2.0 对象库的引用。这也可以通过创建一个用户窗体然后删除它来完成......参考将保留（Excel 2007）。

有关其他剪贴板 API 和代码，请查看：

1) http://www.cpearson.com/excel/Clipboard.aspx 2) http://msdn.microsoft.com/en-us/library/office/ff192913.aspx 3) http://msdn.microsoft。 com/en-us/library/windows/desktop/ms648709%28v=vs.85%29.aspx

还有其他可能的方法，但我认为这些是最稳定和可靠的。我将按原样保留代码，以便它适用于 VBA 和 VBScript

score 1 · Accepted Answer

1

使用文本框。我知道 ActiveX 文本框甚至可以分配滚动条。

于 2013-10-10T21:57:17.743 回答

vba - MsgBox 对于文本来说不够大

2 回答 2

Related

Reference