VBAを使用してイミディエイトウィンドウをクリアする方法を知っている人はいますか?
自分でいつでも手動でクリアできますが、プログラムでこれを行う方法があるかどうか興味があります。
以下は here からの解決策です
Sub stance()
Dim x As Long
For x = 1 To 10
Debug.Print x
Next
Debug.Print Now
Application.SendKeys "^g ^a {DEL}"
End Sub
それをするのはずっと難しいと思いました。恐ろしいSendkeys
を回避するバージョン ここ keepitcoolを見つけました
これを通常のモジュールから実行します。
最初の投稿がプライベート関数宣言を逃したため更新されました-あなたによるコピーと貼り付けのジョブは本当に悪いです
Private Declare Function GetWindow _
Lib "user32" ( _
ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
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 GetKeyboardState _
Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState _
Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function PostMessage _
Lib "user32" Alias "PostMessageA" ( _
ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long _
) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const KEYSTATE_KEYDOWN As Long = &H80
Private savState(0 To 255) As Byte
Sub ClearImmediateWindow()
'Adapted by keepITcool
'Original from Jamie Collins fka "OneDayWhen"
'http://www.dicks-blog.com/Excel/2004/06/clear_the_immed.html
Dim hPane As Long
Dim tmpState(0 To 255) As Byte
hPane = GetImmHandle
If hPane = 0 Then MsgBox "Immediate Window not found."
If hPane < 1 Then Exit Sub
'Save the keyboardstate
GetKeyboardState savState(0)
'Sink the CTRL (note we work with the empty tmpState)
tmpState(vbKeyControl) = KEYSTATE_KEYDOWN
SetKeyboardState tmpState(0)
'Send CTRL+End
PostMessage hPane, WM_KEYDOWN, vbKeyEnd, 0&
'Sink the SHIFT
tmpState(vbKeyShift) = KEYSTATE_KEYDOWN
SetKeyboardState tmpState(0)
'Send CTRLSHIFT+Home and CTRLSHIFT+BackSpace
PostMessage hPane, WM_KEYDOWN, vbKeyHome, 0&
PostMessage hPane, WM_KEYDOWN, vbKeyBack, 0&
'Schedule cleanup code to run
Application.OnTime Now + TimeSerial(0, 0, 0), "DoCleanUp"
End Sub
Sub DoCleanUp()
' Restore keyboard state
SetKeyboardState savState(0)
End Sub
Function GetImmHandle() As Long
'This function finds the Immediate Pane and returns a handle.
'Docked or MDI, Desked or Floating, Visible or Hidden
Dim oWnd As Object, bDock As Boolean, bShow As Boolean
Dim sMain$, sDock$, sPane$
Dim lMain&, lDock&, lPane&
On Error Resume Next
sMain = Application.VBE.MainWindow.Caption
If Err <> 0 Then
MsgBox "No Access to Visual Basic Project"
GetImmHandle = -1
Exit Function
' Excel2003: Registry Editor (Regedit.exe)
' HKLM\SOFTWARE\Microsoft\Office\11.0\Excel\Security
' Change or add a DWORD called 'AccessVBOM', set to 1
' Excel2002: Tools/Macro/Security
' Tab 'Trusted Sources', Check 'Trust access..'
End If
For Each oWnd In Application.VBE.Windows
If oWnd.Type = 5 Then
bShow = oWnd.Visible
sPane = oWnd.Caption
If Not oWnd.LinkedWindowFrame Is Nothing Then
bDock = True
sDock = oWnd.LinkedWindowFrame.Caption
End If
Exit For
End If
Next
lMain = FindWindow("wndclass_desked_gsk", sMain)
If bDock Then
'Docked within the VBE
lPane = FindWindowEx(lMain, 0&, "VbaWindow", sPane)
If lPane = 0 Then
'Floating Pane.. which MAY have it's own frame
lDock = FindWindow("VbFloatingPalette", vbNullString)
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
While lDock > 0 And lPane = 0
lDock = GetWindow(lDock, 2) 'GW_HWNDNEXT = 2
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
Wend
End If
ElseIf bShow Then
lDock = FindWindowEx(lMain, 0&, "MDIClient", _
vbNullString)
lDock = FindWindowEx(lDock, 0&, "DockingView", _
vbNullString)
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
Else
lPane = FindWindowEx(lMain, 0&, "VbaWindow", sPane)
End If
GetImmHandle = lPane
End Function
SendKeysはまっすぐですが、気に入らない場合があります(たとえば、イミディエイトウィンドウが閉じられていた場合は開き、フォーカスを移動します)。
WinAPI + VBEの方法は本当に手の込んだものですが、VBAへのVBAアクセスを許可したくない場合があります(会社のグループポリシーでもないかもしれません)。
クリアする代わりに、その内容をフラッシュすることができます(またはその一部...)ブランクで:
Debug.Print String(65535, vbCr)
残念ながら、これは、キャレット位置がイミディエイトウィンドウの末尾にある場合にのみ機能します(文字列は挿入され、追加されません)。 Debug.Printを介してのみコンテンツを投稿し、ウィンドウをインタラクティブに使用しない場合、これはジョブを実行します。ウィンドウを積極的に使用し、ときどきコンテンツ内に移動する場合、これはあまり役に立ちません。
またはさらにシンプル
Sub clearDebugConsole()
For i = 0 To 100
Debug.Print ""
Next i
End Sub
アイデアの組み合わせは次のとおりです(Excel vba 2007でテスト済み):
'*(これは、日々のデバッグの呼び出しに取って代わることができます)
Public Sub MyDebug(sPrintStr As String, Optional bClear As Boolean = False)
If bClear = True Then
Application.SendKeys "^g^{END}", True
DoEvents ' !!! DoEvents is VERY IMPORTANT here !!!
Debug.Print String(30, vbCrLf)
End If
Debug.Print sPrintStr
End Sub
即時コンテンツを削除するのは好きではありません(誤ってコードを削除することを恐れているため、上記はすべてのコードのハックです)。
これは、Akos Grollerが上記について書いている問題を処理します。「残念ながら、これは、キャレットの位置がイミディエイトウィンドウの最後にある場合にのみ機能します
コードは、イミディエイトウィンドウを開き(またはフォーカスを置く)、Ctrlキーを押しながらEndキーを押して改行を送信します。そのため、以前のデバッグコンテンツは表示されません。
DoEvents is critical、そうでない場合はロジックが失敗することに注意してください(キャレットの位置はイミディエイトウィンドウの最後まで移動しません)。
同じ問題がありました。 Microsoftリンクの助けを借りて問題を解決した方法は次のとおりです。 https://msdn.Microsoft.com/en-us/library/office/gg278655.aspx
Sub clearOutputWindow()
Application.SendKeys "^g ^a"
Application.SendKeys "^g ^x"
End Sub
いくつかの実験の後、mehowのコードに次のようにいくつかのMODを作成しました。
また、プロジェクトでは、VBAプロジェクトオブジェクトモデルに対する信頼が有効になっている必要があることに注意しました。
' DEPENDENCIES
' 1. Add reference:
' Tools > References > Microsoft Visual Basic for Applications Extensibility 5.3
' 2. Enable VBA project access:
' Backstage / Options / Trust Centre / Trust Center Settings / Trust access to the VBA project object model
Public Function ClearImmediateWindow()
On Error GoTo ErrorHandler
Dim myVBE As VBE
Dim winImm As VBIDE.Window
Dim winActive As VBIDE.Window
Set myVBE = Application.VBE
Set winActive = myVBE.ActiveWindow
Set winImm = myVBE.Windows("Immediate")
' Make sure the Immediate window is visible
winImm.Visible = True
' Switch the focus to the Immediate window
winImm.SetFocus
' Send the key sequence to select the window contents and delete it:
' Ctrl+Home to move cursor to the top then Ctrl+Shift+End to move while
' selecting to the end then Delete
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
' Return the focus to the user's original window
' (comment out next line if your code disappears instead!)
'winActive.SetFocus
' Release object variables memory
Set myVBE = Nothing
Set winImm = Nothing
Set winActive = Nothing
' Avoid the error handler and exit this procedure
Exit Function
ErrorHandler:
MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description, _
vbCritical + vbOKOnly, "There was an unexpected error."
Resume Next
End Function
ワークシートのボタンを介してトリガーされた場合、マークされた回答は機能しません。 Ctrlキーを押しながらGキーを押すと、[Excelに移動]ダイアログボックスが開きます。前にイミディエイトウィンドウでSetFocusする必要があります。 DoEvent
が必要な場合は、Debug.Print
クリア直後。
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^g ^a {DEL}"
DoEvents
完全を期すために、@ Austin Dが気づいたように:
不思議な人のために、ショートカットキーはCtrl + G(イミディエイトウィンドウをアクティブにする)、Ctrl + A(すべてを選択する)、Del(クリアする)です。
Immediateウィンドウのクリーニングには、(VBA Excel 2016)next関数を使用します:
_Private Sub ClrImmediate()
With Application.VBE.Windows("Immediate")
.SetFocus
Application.SendKeys "^g", True
Application.SendKeys "^a", True
Application.SendKeys "{DEL}", True
End With
End Sub
_
ただし、ClrImmediate()
の直接呼び出しは次のようになります。
_Sub ShowCommandBarNames()
ClrImmediate
'-- DoEvents
Debug.Print "next..."
End Sub
_
_Debug.Print
_にブレークポイントを設定した場合にのみ機能します。そうでない場合、クリアはShowCommandBarNames()
の実行後に行われます-Debug.Printの前ではありません。残念ながら、DoEvents()
の呼び出しは私を助けませんでした...そして、関係なく:[〜#〜] true [〜#〜]または[ 〜#〜] false [〜#〜]はSendKeysに設定されます。
これを解決するために、次のいくつかの呼び出しを使用します。
_Sub ShowCommandBarNames()
'-- ClrImmediate
Debug.Print "next..."
End Sub
Sub start_ShowCommandBarNames()
ClrImmediate
Application.OnTime Now + TimeSerial(0, 0, 1), "ShowCommandBarNames"
End Sub
_
Application.OnTimeを使用することは、VBA IDEのプログラミングに非常に役立つと思われます。この場合、TimeSerial(0、0、)でも使用できます。
一部の言語では機能するが、すべての言語では機能しない可能性があるため、ショートカットキーに依存しないことに賛成です。ここに私の謙虚な貢献を示します。
Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
Debug.Print VBA.String(200, vbNewLine)
End Sub
Sub ClearImmediateWindow()
SendKeys "^{g}", False
DoEvents
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
SendKeys "{F7}", False
End Sub