vba - 在 VBA 中使用控制台作为调试窗口

Question

所以我在 Excel 文档中运行了一些宏，想知道是否有一种方法可以频繁地将文本输出到控制台窗口(基本上就像使用即时窗口一样)。

我知道有多种方法可以将文本写入文件，我只想显示有关正在运行的进程的一些信息，而不使用立即窗口或 Excel 本身内部的其他窗口。

使用它可以帮助我显示一行，但我不想为每一行打开一个新窗口:

Call Shell("cmd.exe /K echo testInfo", vbNormalFocus)

我不想运行命令(也许除了 echo ？)来执行任务，它只是应该显示文本。

预先感谢您的任何建议。

编辑:

作为 @JohnRC 帖子的补充，我找到了一个无需外部应用程序的解决方案:

Call Shell("PowerShell.exe -noexit -command get-content " + strPath + " -wait")

运行上述命令后将信息记录到该位置的文本文件中即可达到目的。

Answer 1

好的，由于我之前的答案遭到了一些反对，我认为我应该尝试为请求提供实际答案，即提供一种将日志消息发送到命令提示符窗口的方法。这里...

此解决方案作为 VBA 类实现，它将消息作为注释行发送到单独运行的命令提示符窗口，该窗口的标题中包含文本“ExcelLog”。该命令提示符必须单独启动。最简单的方法是创建一个名为“ExcelLog”的快捷方式来运行 CMD，然后当打开此快捷方式时，命令提示符窗口的标题中将显示“ExcelLog”。

在电子表格内添加 cConsole 类的代码(如下)，然后在 VBA 代码中创建该类的全局实例并使用方法 .W "message" 发送文本消息作为注释行发送到控制台(在本例中，使用该行的前缀 :: 将其标识为注释)。

cConsole 类查找具有所需标题的任何命令提示符窗口，然后将注释消息发送到该窗口。如果找不到该窗口，它只会跳过该操作，以便 Excel VBA 代码继续执行而不会报告错误。此外，如果您在 Excel VBA 开始运行后打开命令提示符窗口，cConsole 将自动连接到该窗口并开始/恢复发送消息。这意味着您可以随时关闭并重新打开命令提示符 ExcelLog 窗口，而无需中断 VBA 代码的执行。

这似乎对我的设置有效。我认为这比简单地拖尾文本文件要麻烦一些，但是 - 嘿，你付钱并做出选择。

这是 cConsole 类的代码。

Option Explicit

'// cConsole class
'// This class wraps an interface to a separately-started command prompt
'// window to which messages are sent as comments, so that the command prompt
'// window can be used as a real-time scrolling log from Excel.

'// Each instance of this class creates its own connection to the
'// command prompt window which must have a title containing the text
'// "ExcelLog". If such a window is not open then messages are not
'// logged. The command prompt window can be opened after messages
'// have started, and it will be connected when the next message is
'// sent.

'// The simplest way to set up the necessary command prompt window is to
'// create a shortcut on the desktop the name "ExcelLog" which runs CMD

'// Usage - - - - - - - - - - - -
'//
'//     Dim oConsole As New cConsole
'//     :
'//     oConsole.W "Message to be written to the console"
'//


'// Windows functions to get window handles etc
Private 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
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
  (ByVal hWnd As Long) As Long


'// Handle of the excel log window
Private hLogWindow As Long


Private Sub Class_Initialize()
'// On instantiation, attempts to find the ExcelLog window
    findExcelLogWindow

End Sub

Public Sub W(sMsg As String)
    '// Public function used to send the given message
    '// as a comment line to the linked window
   SendToConsole ":: " & sMsg
End Sub
Private Sub SendToConsole(Command As String)
    '// Connects to and sends a command line to the command prompt
    '// window that is being used as the log

    Dim res As Boolean

    '// Check that a connection has been made and
    '// attempt to connect if not
    If hLogWindow = 0 Then
        findExcelLogWindow
        If hLogWindow = 0 Then Exit Sub
    End If

        On Error Resume Next

                Do
                    '// Attempt to bring the logging window to the foreground
                     res = SetForegroundWindow(hLogWindow)

                    '// Check if successful, and send the command if so
                    If res Then
                        SendKeys Command & vbCrLf
                        Exit Do
                    Else
                        '// Not successful, so try reconnecting to the logging window
                        findExcelLogWindow

                        '// If we cannot connect, just exit without sending anything
                        If hLogWindow = 0 Then Exit Sub
                    End If

                Loop

                '// Check if there has been any error
                If Err.Number <> 0 Then
                    hLogWindow = 0
                    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
                End If

        On Error GoTo 0

End Sub
Private Function findExcelLogWindow() As Long
    '// This function looks for a command prompt window that has the text
    '// ExcelLog in the title
    Dim nLen As Long
    Dim sData As String

    Dim Class As String
    Dim Title As String

    '// Get handle to the first window
    hLogWindow = 0

    '// Check each window in turn
    Do

            hLogWindow = FindWindowEx(0&, hLogWindow, vbNullString, vbNullString)

            '// Check that a window was found
            If hLogWindow = 0 Then Exit Do

            '// Get the class name of the window
            sData = String$(100, Chr$(0))
            nLen = GetClassName(hLogWindow, sData, 100)
            Class = Left$(sData, nLen)

            '// Get the title of the window
            sData = String$(100, Chr$(0))
            nLen = GetWindowText(hLogWindow, sData, 100)
            Title = Left$(sData, nLen)

            '// Check if the required window has been found
            If Class = "ConsoleWindowClass" And InStr(Title, "ExcelLog") > 0 Then

                '// Initialise the window to remove any prompt text
                SendToConsole "PROMPT $S"

                '// Write some initial messages
                Me.W "*******************"
                Me.W "[" & ThisWorkbook.Name & "] connected to console at " & Now
                Me.W ""

                '// Return the handle to the log window
                findExcelLogWindow = hLogWindow
                Exit Function


            End If



    Loop

    '// The log window was not found, so return zero
    findExcelLogWindow = 0

End Function

我通过处理工作表中图像控件上的 MouseMove 事件对此进行了测试:

Option Explicit

Private oCons As New cConsole

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    oCons.W "MouseMove " & X & ", " & Y

End Sub

这是结果