MsgBox not big enough for text

前端 未结 2 1697
一整个雨季
一整个雨季 2020-12-20 20:11

I have a string (msg) that is pretty much a very long list of items. I need to put this in a msgbox but it is not long enough to show the whole text. Is there an alternative

相关标签:
2条回答
  • 2020-12-20 20:36

    Use a TextBox. I know ActiveX TextBoxes can even be assigned scrollbars.

    0 讨论(0)
  • 2020-12-20 20:55

    The Message Box function is a built-in function of VBA and cannot exceed 1024 Characters. You are limited to creating your own UserForm or some other alternative... Such as opening and writing to an unsaved instance of notepad...

    An ALL API solution to open Notepad and Write your message to it... NOTE: If your running VBA 7.0 (Office 2010) then you'll have to add PtrSafe just after each Declare Statement...

    At the top of your module paste the API Declarations and Global Variables

    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 function opens a new instance of Notepad and writes to it. If it succeeds, then it will return the Process ID of the Notepad instance.

    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
    

    Routine to Test the Write2Notepad Function

    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
    

    The above code might look like a lot of trouble or more complicated but it will likely work much more reliably and efficiently then any other method.

    The below function will copy your message to the clipboard using the MS clip tool, open notepad, and then paste the clipboard contents (your message) into Notepad... This way you don't have to save anything to a file and its easily closed... Or you can save it if you choose.

    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
    

    You can also add an additional routine to "Sleep" while notepad is open to halt code if you need... See Below

    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
    

    EDIT: I just realized that I wrote the above code to work for VBScript... Since this is Excel, if you want to look into other methods to copy contents to the Clipboard without using the WshShell.Exec method; you can also try:

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

    To use the DataObject in your code, you must set a reference to the Microsoft Forms 2.0 Object Library. This can also be done by creating a UserForm and then Deleting it... The reference will remain (Excel 2007).

    For additional Clipboard API's and code take a look at:

    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

    There are other possible methods but I think these are the most stable and reliable. I will leave the code the way it is so that it will work for both VBA and VBScript

    0 讨论(0)
提交回复
热议问题