MsgBox不够大的文本

我有一个string(味精)是非常长的项目列表。 我需要把它放在一个msgbox中,但它不足以显示整个文本。 有没有其他的select呢?

谢谢!

消息框function是VBA的内置function,不能超过1024个字符。 您只能创build自己的UserForm或其他select…如打开和写入未保存的记事本实例…

一个所有的API解决scheme打开记事本,并写下您的消息…注:如果您运行的VBA 7.0(Office 2010),那么你将不得不添加PtrSafe每个声明声明后…

在模块的顶部粘贴API声明和全局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函数打开记事本的一个新实例并写入它。 如果成功,它将返回记事本实例的进程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 

testingWrite2Notepad函数的例程

 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剪辑工具将您的消息复制到剪贴板,打开记事本,然后将剪贴板内容(您的消息)粘贴到记事本中…这样,您不必将任何内容保存到文件中,closures…或者你可以保存它,如果你select。

 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 

如果您需要,也可以在记事本打开的情况下添加额外的例程以“hibernate”以暂停代码…请参见下文

 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对象库的引用。 这也可以通过创build一个用户窗体,然后删除它…参考将保持(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&#x3002; COM / EN-US /库/窗/台式机/ ms648709%28V = vs.85%29.aspx

还有其他可能的方法,但我认为这是最稳定和可靠的。 我将以这样的方式保留代码,以便VBA和VBScript都能正常工作

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