immediatewindow شخابيط وافكار : اليوم اقدم اليكم منفعة لا غنى عنها (ImmediateWindowHelper)

[ابو جودي]

السلام عليكم ورحمة الله تعالى وبركاته

اليوم اقدم لكم هدية صغيرة ولكن النفع من ورائها عظيم جدا

قد ينتج عن الكود اخطاء عند كتابة الكود 

قد نحتاج تتبع نتائج الكود

قد محتاج معرفة القيم التى يعيدهها الكود

قد نكتب استعلام مثلا زنقطع الاسطر ونضيف متغيرات نمرر منها قيما الى الاستعلام ونريد معرفة كبف سوف يراه الحاسوب فى النهاية 

وقد وقد و ........ الخ وهناك الكثير والكثير وما ذطرته هو فقط على سبيل المثال وليس الحصر 

اتتنى فكرة وهى كتابة كود فى موديول ليسهل الامور على مصممى قواعد البيانات فيضفى المرونة فى التعامل وكذا الاحترافية التامة مع هذا الامر

وهو استخدام:  Debug.Print

وحتى لا اطيل عليكم اليكم الاكواد

Option Compare Database
Option Explicit

'**********************************************************************
' Function: DebugPrint
' Purpose:  Prints a message to the Immediate Window in the VBA editor and optionally logs it to a file.
' Inputs:
'           Message - The message to be printed (String).
'           Optional AddNewLine - A Boolean flag to add a new line after printing (default is True).
'           Optional Prefix - A string to prefix the message (default is "").
'           Optional Suffix - A string to suffix the message (default is "").
'           Optional LogToFile - A Boolean flag to enable logging to a file (default is False).
'           Optional FilePath - The path of the file where the log should be saved (default is "").
' Returns:  Nothing - The function performs a print and/or log operation.
' Notes:
'           - The function sends the message to the Immediate Window.
'           - If AddNewLine is True, a newline is added after the message.
'           - Prefix and Suffix can be used to format the message.
'           - LogToFile enables logging the message to a specified file.
'           - Error handling is included to manage issues with file operations.
'**********************************************************************
' Author:  Officena.net  ,  Mohammed Essm  , soul-angel@msn.com
' Date:    August 2024
'**********************************************************************

Sub DebugPrint(ByVal Message As String, Optional ByVal AddNewLine As Boolean = True, _
                Optional ByVal Prefix As String = "", Optional ByVal Suffix As String = "", _
                Optional ByVal LogToFile As Boolean = False, Optional ByVal FilePath As String = "")

    Dim fullMessage As String
    Dim fileNum As Integer
    
    ' Construct the full message with prefix and suffix
    fullMessage = Prefix & Message & Suffix
    
    ' Print the message to the Immediate Window
    Debug.Print fullMessage
    
    ' Optionally add a newline after printing
    If AddNewLine Then
        Debug.Print "" ' Adds an empty line for separation
    End If
    
    ' Log the message to a file if specified
    If LogToFile And FilePath <> "" Then
        On Error GoTo ErrorHandler
        fileNum = FreeFile
        Open FilePath For Append As #fileNum
        Print #fileNum, fullMessage
        Close #fileNum
        On Error GoTo 0
    End If
    
    Exit Sub
    
ErrorHandler:
    ' Handle any errors that occur during file operations
    Debug.Print "Error occurred while logging to file: " & Err.Description
    On Error GoTo 0
End Sub
' Example 1: Print a simple message
Rem Call DebugPrint("This is a simple message")
' Example 2: Print a message with a prefix and suffix, without adding a new line
Rem DebugPrint("Error encountered!", AddNewLine:=False, Prefix:="Error: ", Suffix:=" [Check details]")
' Example 3: Print a message and log it to a file
Rem DebugPrint("Logging this message to a file.", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt")
' Example 4: Print multiple messages with automatic new lines and logging
Rem DebugPrint("Starting process...")
Rem DebugPrint("Process in progress...")
Rem DebugPrint("Process completed successfully!", LogToFile:=True, FilePath:="C:\path\to\your\logfile.txt")
'---------------------------------------------------------------------------------------------------------------------------------------



'**********************************************************************
' Subroutine: OpenImmediateWindow
' Purpose:  Opens the Immediate Window in the VBA editor and prepares it for input.
' Inputs:   None
' Returns:  Nothing
' Notes:
'           - The Immediate Window is activated and ready for input.
'           - This subroutine uses the SendKeys method to send keystrokes.
'           - Error handling is included to manage potential issues with SendKeys.
'**********************************************************************
' Author:  Officena.net  ,  Mohammed Essm  , soul-angel@msn.com
' Date:    August 2024
'**********************************************************************
Public Sub OpenImmediateWindow()
    Dim shell As Object
    
    On Error GoTo ErrorHandler
    ' Create an instance of WScript.Shell to send keystrokes
    Set shell = CreateObject("WScript.Shell")
    
    With shell
        ' Send Ctrl+G to open the Immediate Window
        .SendKeys "^g ", True
        ' Send Tab to navigate if needed
        .SendKeys "{TAB}", True
    End With
    
    Application.VBE.MainWindow.Visible = True
    DoEvents 'this frees up the OS to repaint the screen
    
    Exit Sub
     ' Clean up
    Set shell = Nothing
ErrorHandler:
    ' Handle any errors that occur during SendKeys operations
    Debug.Print "Error occurred while opening the Immediate Window: " & Err.Description
    On Error GoTo 0
End Sub


'**********************************************************************
' Function: ClearImmediateWindowContent
' Purpose: Clears the content of the Immediate Window in the VBA Editor.
' Details:
'          This function searches for an open Immediate Window within the VBE.
'          If found, it sends keystrokes to clear the content using the WScript.Shell object.
' Inputs: None
' Returns: Void
' Error Handling:
'          Includes basic error handling to inform the user in case of an issue.
' Notes:
'          - This function assumes that there is only one Immediate Window open.
'          - The function does not create a new Immediate Window if one is not found.
'**********************************************************************
Public Function ClearImmediateWindowContent()
    On Error GoTo ErrorHandler

    Dim totalVBEWindows As Long
    Dim currentWindowIndex As Long
    Const IMMEDIATE_WINDOW_TYPE As Long = 5 ' Type constant for Immediate Window
    Dim shell As Object
    
    ' Create an instance of WScript.Shell to send keystrokes
    Set shell = CreateObject("WScript.Shell")
                
    totalVBEWindows = Application.VBE.Windows.Count ' Get the number of open windows

    ' Iterate through all open windows
    For currentWindowIndex = 1 To totalVBEWindows
        ' Check if the current window is the Immediate Window
        If Application.VBE.Windows.Item(currentWindowIndex).Type = IMMEDIATE_WINDOW_TYPE Then
            Application.VBE.Windows.Item(currentWindowIndex).SetFocus ' Set focus to the Immediate Window
            
            ' Ensure the Immediate Window is active
            If Application.VBE.ActiveWindow.Type = IMMEDIATE_WINDOW_TYPE Then

                With shell
                    ' Send Ctrl+G to activate the Immediate Window
                    .SendKeys "^g", True
                    ' Send Ctrl+A to select all content
                    .SendKeys "^a", True
                    ' Send Delete to clear selected content
                    .SendKeys "{DEL}", True
                    ' Send Backspace to ensure content is cleared
                    .SendKeys "{BKSP}", True
                End With

                Exit Function ' Exit after clearing the content
            End If
            
            Exit For ' Exit the loop if Immediate Window is found and focused
        End If
    Next currentWindowIndex
    ' Clean up
    Set shell = Nothing
    Exit Function

ErrorHandler:
    MsgBox "Error occurred while trying to clear the Immediate Window. Error: " & Err.Description, vbCritical
    ' Clean up
    Set shell = Nothing
End Function


'**********************************************************************
' Function: GetDesktopPath
' Purpose: Returns the path to the Desktop for the current user.
' Details:
'          This function retrieves the path to the Desktop folder using Windows API functions.
' Inputs: None
' Returns: String - The full path to the Desktop folder.
' Notes:
'          - This function uses Windows API to get the Desktop path.
'          - Ensure you have error handling to manage unexpected issues.
'**********************************************************************
Public Function GetDesktopPath() As String
    Dim strDesktopPath As String
    Dim objShell As Object

    On Error GoTo ErrorHandler

    ' Create an instance of Shell object
    Set objShell = CreateObject("Shell.Application")

    ' Get the Desktop folder path
    strDesktopPath = objShell.NameSpace(&H10&).Self.Path
    
    ' Return the path
    GetDesktopPath = strDesktopPath

    Exit Function

ErrorHandler:
    MsgBox "Error occurred while retrieving the Desktop path. Error: " & Err.Description, vbCritical
    GetDesktopPath = ""
End Function

 

بالمناسبة لا داعى للقلق من وجود واستخدام "SendKeys" داخل الاكود لانه تم التعامل معها بحرفية تامة كى لا تأثر على حالة الـ Num Lock 

 

ImmediateWindowHelper.accdb

[ابوخليل]

جميل جدا ابا جودي

كنت عزمت على اعداد وعرض دروس للتعامل مع الأخطاء بأنواعها داخل الحدث ..

ولكن يبدو اني سوف أتريث  لما بعد تجربة هذه الأكواد

شكرا لك

[ابو جودي]

12 ساعات مضت, ابوخليل said:

جميل جدا ابا جودي

كنت عزمت على اعداد وعرض دروس للتعامل مع الأخطاء بأنواعها داخل الحدث ..

ولكن يبدو اني سوف أتريث  لما بعد تجربة هذه الأكواد

شكرا لك

استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل 

يسعدنى ويشرفنى مروركم 

قمت بتعديل فى دالة تنظيف الناذة الفورية لانه لاحظت انها تعمل تارة ولا تعمل أخرى 

قمت بتعديل الكود وقمت بالتتجربة بأكثر من مرة و قمت بإضافة مرفق فى رأس الموضوع لتجربة شاملة وشيقة انشاء الله 

[ابو ياسين المشولي]

بارك الله فيك وجعله في ميزان حسناتك

[abouelhassan]

شكر وتقدير واحترام 

[عمر ضاحى]

بسم الله ما شاء الله 
ابدعت وهتخلينى افكر بطريقه مختلفه 

تسلم يا هندسه 

 

استاذي @Moosak   ضيفها فى المكتبه العامره الله يبارك فيك