דילוג לתוכן
  • דף הבית
  • קטגוריות
  • פוסטים אחרונים
  • משתמשים
  • חיפוש
  • חוקי הפורום
כיווץ
תחומים

תחומים - פורום חרדי מקצועי

💡 רוצה לזכור קריאת שמע בזמן? לחץ כאן!
  1. דף הבית
  2. תכנות
  3. Custom MsgBox VBA

Custom MsgBox VBA

מתוזמן נעוץ נעול הועבר תכנות
24 פוסטים 6 כותבים 907 צפיות 4 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • Y yits

    חיפשתי הרבה זמן איך אפשר להתאים אישית את הכפתורים ב MsgBox של Office VBA.

    מכיוון שמצאתי מודול מאוד נחמד שעושה את העבודה וגם שיפרתי אותו קצת אני יעלה אותו כאן.

    מי שרוצה לשפר את הקוד יש בעיה ב Select Case MsgBox_Style ועשיתי שם טלאי עבור RTL, נשמח לקבל פתרון יותר טוב ויפה.

    כדי להשתמש בקוד יש ליצור מודול חדש ולהעתיק את כל הקוד לתוכו.

    Option Explicit
    
    ' (C) Dan Elgaard (www.EXCELGAARD.dk)
    
    ' MsgBox Buttons/Answers ID Constants
    Private Const MsgBox_Button_ID_OK     As Long = 1
    Private Const MsgBox_Button_ID_Cancel As Long = 2
    Private Const MsgBox_Button_ID_Abort  As Long = 3
    Private Const MsgBox_Button_ID_Retry  As Long = 4
    Private Const MsgBox_Button_ID_Ignore As Long = 5
    Private Const MsgBox_Button_ID_Yes    As Long = 6
    Private Const MsgBox_Button_ID_No     As Long = 7
    
    ' MsgBox Buttons/Answers Text Variables'
    Private MsgBox_Button_Text_OK         As String
    Private MsgBox_Button_Text_Cancel     As String
    Private MsgBox_Button_Text_Abort      As String
    Private MsgBox_Button_Text_Retry      As String
    Private MsgBox_Button_Text_Ignore     As String
    Private MsgBox_Button_Text_Yes        As String
    Private MsgBox_Button_Text_No         As String
    
    ' Handle to the Hook procedure'
    #If VBA7 Then
        Private MsgBoxHookHandle          As LongPtr                                        ' 64-bit handle'
        Private MsgBoxHookHandle2         As LongPtr                                        ' 64-bit handle'
    #Else
        Private MsgBoxHookHandle          As Long
        Private MsgBoxHookHandle2         As Long
    #End If
     
    'Clip Cursor'
    Private Type RECT
        Left As Long
        Top As Long
        right As Long
        bottom As Long
    End Type
    
    Enum eVbMsgBoxIconCB
        vbCritical = 16
        vbExclamation = 48
        vbInformation = 64
        vbQuestion = 32
    End Enum
    
    Enum eVbMsgBoxStyleCB
        vbApplicationModal = 0
        vbMsgBoxRight = 524288
        vbMsgBoxRtlReading = 1048576
        vbMsgBoxSetForeground = 65536
        vbSystemModal = 4096
    End Enum
    
    ' Windows API functions'
    #If VBA7 Then
        Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
        Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
        Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
        Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
        Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
        Private Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
        Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    #Else
        Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
        Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
        Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
        Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
        Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
        Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
        Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    #End If
    
    
    #If VBA7 Then
        Private Function MsgBoxHook(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel          ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
                    
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                    
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect 'ClipCursor
            End If
        End Function
    #Else
        Private Function MsgBoxHook(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
            SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
            SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
            SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
            SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
            SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
            SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
            SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
                    
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                    
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect 'ClipCursor
            End If
        End Function
    #End If
    
    
    Function MsgBoxCB(MsgBox_Text As String, _
                        Button1 As String, _
                        Optional Button2 As String, _
                        Optional Button3 As String, _
                        Optional MsgBox_Style As eVbMsgBoxStyleCB, _
                        Optional MsgBox_Icon As eVbMsgBoxIconCB, _
                        Optional MsgBox_Title As String) As Long
    
        ' * ' Initialize
        On Error Resume Next
    
        ' * ' Define variables
        If Button1 = vbNullString Then
            Button1 = Button2
            Button2 = vbNullString
        End If
        If Button2 = vbNullString Then
            Button2 = Button3
            Button3 = vbNullString
        End If
    
        Dim ButtonsToUse As Long
        ButtonsToUse = vbAbortRetryIgnore
        If Button3 = vbNullString Then ButtonsToUse = vbYesNo
        If Button2 = vbNullString Then ButtonsToUse = vbOKOnly
    
        Select Case MsgBox_Icon
            Case vbCritical:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbExclamation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbInformation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
            Case vbQuestion:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
        End Select
    
        Select Case MsgBox_Style
            Case vbApplicationModal:      ButtonsToUse = ButtonsToUse + MsgBox_Style
            Case vbMsgBoxRight:           ButtonsToUse = ButtonsToUse + MsgBox_Style
            Case vbMsgBoxRtlReading:      ButtonsToUse = ButtonsToUse + MsgBox_Style
            Case vbMsgBoxSetForeground:   ButtonsToUse = ButtonsToUse + MsgBox_Style
            Case vbSystemModal:           ButtonsToUse = ButtonsToUse + MsgBox_Style
            Case vbMsgBoxRight + vbMsgBoxRtlReading: ButtonsToUse = ButtonsToUse + MsgBox_Style
        End Select
        
        If MsgBox_Title = vbNullString Then MsgBox_Title = " Microsoft Office"               ' Default MsgBox title
    
        Dim MsgBoxAnswer As Long
    
        ' * ' Set custom buttons texts
        MsgBox_Button_Text_OK = Button1
        MsgBox_Button_Text_Cancel = vbNullString                                            ' Not used
        MsgBox_Button_Text_Abort = Button1
        MsgBox_Button_Text_Retry = Button2
        MsgBox_Button_Text_Ignore = Button3
        MsgBox_Button_Text_Yes = Button1
        MsgBox_Button_Text_No = Button2
    
        MsgBoxHookHandle = SetWindowsHookEx(5, AddressOf MsgBoxHook, 0, GetCurrentThreadId) ' Set MsgBox Hook
    
        ' * ' Show hooked MsgBox
        MsgBoxAnswer = MsgBox(MsgBox_Text, ButtonsToUse, MsgBox_Title)
    
    EF: ' End of Function
        UnhookWindowsHookEx MsgBoxHookHandle                                                ' Unhook MsgBox again
        ClipCursor ByVal 0 'Relase ClipCursor
        Select Case MsgBoxAnswer
            Case vbOK:        MsgBoxCB = 1
            Case vbCancel:    MsgBoxCB = 0                                                ' Not used
            Case vbAbort:     MsgBoxCB = 1
            Case vbRetry:     MsgBoxCB = 2
            Case vbIgnore:    MsgBoxCB = 3
            Case vbYes:       MsgBoxCB = 1
            Case vbNo:        MsgBoxCB = 2
        End Select
    End Function
    
    
    Public Property Let MsgboxClipCursor(ByVal Clip As Boolean)
        If Clip Then
            MsgBoxHookHandle2 = SetWindowsHookEx(5, AddressOf MsgBoxClipProc, 0, GetCurrentThreadId)
        Else
            ClipCursor ByVal 0
            UnhookWindowsHookEx MsgBoxHookHandle2
        End If
    End Property
    
    #If VBA7 Then
        Private Function MsgBoxClipProc(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
    #Else
        Private Function MsgBoxClipProc(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
    #End If
                
            Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                    
            ret = GetClassName(WP, sBuffer, Len(sBuffer))
            If Left(sBuffer, ret) = "#32770" Then
                GetWindowRect WP, tMsgBoxRect
                With tMsgBoxRect
                    .right = .right - 2: .bottom = .bottom - 2
                End With
                ClipCursor tMsgBoxRect
            End If
        End Function
    
    

    כדי לממש את הקוד יש לכתוב את הפקודה כך

    MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
    
    zvinissimZ מנותק
    zvinissimZ מנותק
    zvinissim
    כתב ב נערך לאחרונה על ידי
    #2

    @yits שאלונת
    לא יותר פשוט לבנות טופס קטן מוקפץ עם כמה כפתורים ולהקפיץ אותו בכל פעם ולשנות את הכיתובים?

    אני עשיתי כך מספר פעמים ואז לשלוט על אירועי הכפתורים

    פורום אופיס
    לכל הטיפים שלי

    Y תגובה 1 תגובה אחרונה
    2
    • zvinissimZ zvinissim

      @yits שאלונת
      לא יותר פשוט לבנות טופס קטן מוקפץ עם כמה כפתורים ולהקפיץ אותו בכל פעם ולשנות את הכיתובים?

      אני עשיתי כך מספר פעמים ואז לשלוט על אירועי הכפתורים

      Y מנותק
      Y מנותק
      yits
      כתב ב נערך לאחרונה על ידי
      #3

      @zvinissim אמר בCustom MsgBox VBA:

      @yits שאלונת
      לא יותר פשוט לבנות טופס קטן מוקפץ עם כמה כפתורים ולהקפיץ אותו בכל פעם ולשנות את הכיתובים?

      אני עשיתי כך מספר פעמים ואז לשלוט על אירועי הכפתורים

      גם אני עשיתי כך בעבר אבל רק להודעה מסויימת.

      אם אתה רוצה לעשות משהו שיהיה דינאמי זה נראה לי קצת מסובך:

      1. איך אתה מקבל תשובה מה המשתמש בחר?
        בשביל זה אתה משתמש במשתנים גלובליים?.
      2. אם תרצה לקרוא לזה כפונקציה תצטרך ליצור משתנים גלובליים מכיוון שטופס לא יודע לקבל פרמטרים בצורה נורמלית.
        או שתשתמש ב OpenArgs ותשרשר מחרוזת ארוכה עם הפרדה של ; (או משהו כזה) ואח"כ תפענח את זה.
      3. ואם תרצה שיהיו רק 2 כפתורים במקום 3 או להיפך
        אתה צריך לעשות טופס דינאמי או להגדיר Visable לכל אחד ואז לסדר את המיקומים.

      אם יש לך משהו כזה דינאמי נשמח לקבל אותו.

      לקניה והנחות ב KSP כנסו מכאן.
      למוצרים עם הנחה מכאן.

      zvinissimZ תגובה 1 תגובה אחרונה
      2
      • Y yits

        חיפשתי הרבה זמן איך אפשר להתאים אישית את הכפתורים ב MsgBox של Office VBA.

        מכיוון שמצאתי מודול מאוד נחמד שעושה את העבודה וגם שיפרתי אותו קצת אני יעלה אותו כאן.

        מי שרוצה לשפר את הקוד יש בעיה ב Select Case MsgBox_Style ועשיתי שם טלאי עבור RTL, נשמח לקבל פתרון יותר טוב ויפה.

        כדי להשתמש בקוד יש ליצור מודול חדש ולהעתיק את כל הקוד לתוכו.

        Option Explicit
        
        ' (C) Dan Elgaard (www.EXCELGAARD.dk)
        
        ' MsgBox Buttons/Answers ID Constants
        Private Const MsgBox_Button_ID_OK     As Long = 1
        Private Const MsgBox_Button_ID_Cancel As Long = 2
        Private Const MsgBox_Button_ID_Abort  As Long = 3
        Private Const MsgBox_Button_ID_Retry  As Long = 4
        Private Const MsgBox_Button_ID_Ignore As Long = 5
        Private Const MsgBox_Button_ID_Yes    As Long = 6
        Private Const MsgBox_Button_ID_No     As Long = 7
        
        ' MsgBox Buttons/Answers Text Variables'
        Private MsgBox_Button_Text_OK         As String
        Private MsgBox_Button_Text_Cancel     As String
        Private MsgBox_Button_Text_Abort      As String
        Private MsgBox_Button_Text_Retry      As String
        Private MsgBox_Button_Text_Ignore     As String
        Private MsgBox_Button_Text_Yes        As String
        Private MsgBox_Button_Text_No         As String
        
        ' Handle to the Hook procedure'
        #If VBA7 Then
            Private MsgBoxHookHandle          As LongPtr                                        ' 64-bit handle'
            Private MsgBoxHookHandle2         As LongPtr                                        ' 64-bit handle'
        #Else
            Private MsgBoxHookHandle          As Long
            Private MsgBoxHookHandle2         As Long
        #End If
         
        'Clip Cursor'
        Private Type RECT
            Left As Long
            Top As Long
            right As Long
            bottom As Long
        End Type
        
        Enum eVbMsgBoxIconCB
            vbCritical = 16
            vbExclamation = 48
            vbInformation = 64
            vbQuestion = 32
        End Enum
        
        Enum eVbMsgBoxStyleCB
            vbApplicationModal = 0
            vbMsgBoxRight = 524288
            vbMsgBoxRtlReading = 1048576
            vbMsgBoxSetForeground = 65536
            vbSystemModal = 4096
        End Enum
        
        ' Windows API functions'
        #If VBA7 Then
            Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
            Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
            Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
            Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
            Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
            Private Declare PtrSafe Function ClipCursor Lib "user32" (lpRect As Any) As Long
            Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        #Else
            Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
            Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
            Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
            Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
            Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
            Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
            Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        #End If
        
        
        #If VBA7 Then
            Private Function MsgBoxHook(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
                SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
                SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel          ' Not used
                SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
                SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
                SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
                SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
                SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
                        
                Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                        
                ret = GetClassName(WP, sBuffer, Len(sBuffer))
                If Left(sBuffer, ret) = "#32770" Then
                    GetWindowRect WP, tMsgBoxRect
                    With tMsgBoxRect
                        .right = .right - 2: .bottom = .bottom - 2
                    End With
                    ClipCursor tMsgBoxRect 'ClipCursor
                End If
            End Function
        #Else
            Private Function MsgBoxHook(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
                SetDlgItemText WP, MsgBox_Button_ID_OK, MsgBox_Button_Text_OK
                SetDlgItemText WP, MsgBox_Button_ID_Cancel, MsgBox_Button_Text_Cancel         ' Not used
                SetDlgItemText WP, MsgBox_Button_ID_Abort, MsgBox_Button_Text_Abort
                SetDlgItemText WP, MsgBox_Button_ID_Retry, MsgBox_Button_Text_Retry
                SetDlgItemText WP, MsgBox_Button_ID_Ignore, MsgBox_Button_Text_Ignore
                SetDlgItemText WP, MsgBox_Button_ID_Yes, MsgBox_Button_Text_Yes
                SetDlgItemText WP, MsgBox_Button_ID_No, MsgBox_Button_Text_No
                        
                Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                        
                ret = GetClassName(WP, sBuffer, Len(sBuffer))
                If Left(sBuffer, ret) = "#32770" Then
                    GetWindowRect WP, tMsgBoxRect
                    With tMsgBoxRect
                        .right = .right - 2: .bottom = .bottom - 2
                    End With
                    ClipCursor tMsgBoxRect 'ClipCursor
                End If
            End Function
        #End If
        
        
        Function MsgBoxCB(MsgBox_Text As String, _
                            Button1 As String, _
                            Optional Button2 As String, _
                            Optional Button3 As String, _
                            Optional MsgBox_Style As eVbMsgBoxStyleCB, _
                            Optional MsgBox_Icon As eVbMsgBoxIconCB, _
                            Optional MsgBox_Title As String) As Long
        
            ' * ' Initialize
            On Error Resume Next
        
            ' * ' Define variables
            If Button1 = vbNullString Then
                Button1 = Button2
                Button2 = vbNullString
            End If
            If Button2 = vbNullString Then
                Button2 = Button3
                Button3 = vbNullString
            End If
        
            Dim ButtonsToUse As Long
            ButtonsToUse = vbAbortRetryIgnore
            If Button3 = vbNullString Then ButtonsToUse = vbYesNo
            If Button2 = vbNullString Then ButtonsToUse = vbOKOnly
        
            Select Case MsgBox_Icon
                Case vbCritical:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
                Case vbExclamation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
                Case vbInformation:     ButtonsToUse = ButtonsToUse + MsgBox_Icon
                Case vbQuestion:        ButtonsToUse = ButtonsToUse + MsgBox_Icon
            End Select
        
            Select Case MsgBox_Style
                Case vbApplicationModal:      ButtonsToUse = ButtonsToUse + MsgBox_Style
                Case vbMsgBoxRight:           ButtonsToUse = ButtonsToUse + MsgBox_Style
                Case vbMsgBoxRtlReading:      ButtonsToUse = ButtonsToUse + MsgBox_Style
                Case vbMsgBoxSetForeground:   ButtonsToUse = ButtonsToUse + MsgBox_Style
                Case vbSystemModal:           ButtonsToUse = ButtonsToUse + MsgBox_Style
                Case vbMsgBoxRight + vbMsgBoxRtlReading: ButtonsToUse = ButtonsToUse + MsgBox_Style
            End Select
            
            If MsgBox_Title = vbNullString Then MsgBox_Title = " Microsoft Office"               ' Default MsgBox title
        
            Dim MsgBoxAnswer As Long
        
            ' * ' Set custom buttons texts
            MsgBox_Button_Text_OK = Button1
            MsgBox_Button_Text_Cancel = vbNullString                                            ' Not used
            MsgBox_Button_Text_Abort = Button1
            MsgBox_Button_Text_Retry = Button2
            MsgBox_Button_Text_Ignore = Button3
            MsgBox_Button_Text_Yes = Button1
            MsgBox_Button_Text_No = Button2
        
            MsgBoxHookHandle = SetWindowsHookEx(5, AddressOf MsgBoxHook, 0, GetCurrentThreadId) ' Set MsgBox Hook
        
            ' * ' Show hooked MsgBox
            MsgBoxAnswer = MsgBox(MsgBox_Text, ButtonsToUse, MsgBox_Title)
        
        EF: ' End of Function
            UnhookWindowsHookEx MsgBoxHookHandle                                                ' Unhook MsgBox again
            ClipCursor ByVal 0 'Relase ClipCursor
            Select Case MsgBoxAnswer
                Case vbOK:        MsgBoxCB = 1
                Case vbCancel:    MsgBoxCB = 0                                                ' Not used
                Case vbAbort:     MsgBoxCB = 1
                Case vbRetry:     MsgBoxCB = 2
                Case vbIgnore:    MsgBoxCB = 3
                Case vbYes:       MsgBoxCB = 1
                Case vbNo:        MsgBoxCB = 2
            End Select
        End Function
        
        
        Public Property Let MsgboxClipCursor(ByVal Clip As Boolean)
            If Clip Then
                MsgBoxHookHandle2 = SetWindowsHookEx(5, AddressOf MsgBoxClipProc, 0, GetCurrentThreadId)
            Else
                ClipCursor ByVal 0
                UnhookWindowsHookEx MsgBoxHookHandle2
            End If
        End Property
        
        #If VBA7 Then
            Private Function MsgBoxClipProc(ByVal LM As LongPtr, ByVal WP As LongPtr, ByVal LP As LongPtr) As LongPtr
        #Else
            Private Function MsgBoxClipProc(ByVal LM As Long, ByVal WP As Long, ByVal LP As Long) As Long
        #End If
                    
                Dim tMsgBoxRect As RECT, sBuffer As String * 256, ret As Long
                        
                ret = GetClassName(WP, sBuffer, Len(sBuffer))
                If Left(sBuffer, ret) = "#32770" Then
                    GetWindowRect WP, tMsgBoxRect
                    With tMsgBoxRect
                        .right = .right - 2: .bottom = .bottom - 2
                    End With
                    ClipCursor tMsgBoxRect
                End If
            End Function
        
        

        כדי לממש את הקוד יש לכתוב את הפקודה כך

        MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
        
        חייםיודלביץח מנותק
        חייםיודלביץח מנותק
        חייםיודלביץ
        כתב ב נערך לאחרונה על ידי
        #4

        @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

        אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
        שגיאה.png

        זה משה שעשיתי באקסס
        העתעקתי למודול חדש
        שמתי את הקוד הזה

        MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
        

        בלחצן ואז הוא כתב לי את השגיאה הנ"ל

        אשמח לעזרה
        תודה

        Y תגובה 1 תגובה אחרונה
        1
        • Y yits

          @zvinissim אמר בCustom MsgBox VBA:

          @yits שאלונת
          לא יותר פשוט לבנות טופס קטן מוקפץ עם כמה כפתורים ולהקפיץ אותו בכל פעם ולשנות את הכיתובים?

          אני עשיתי כך מספר פעמים ואז לשלוט על אירועי הכפתורים

          גם אני עשיתי כך בעבר אבל רק להודעה מסויימת.

          אם אתה רוצה לעשות משהו שיהיה דינאמי זה נראה לי קצת מסובך:

          1. איך אתה מקבל תשובה מה המשתמש בחר?
            בשביל זה אתה משתמש במשתנים גלובליים?.
          2. אם תרצה לקרוא לזה כפונקציה תצטרך ליצור משתנים גלובליים מכיוון שטופס לא יודע לקבל פרמטרים בצורה נורמלית.
            או שתשתמש ב OpenArgs ותשרשר מחרוזת ארוכה עם הפרדה של ; (או משהו כזה) ואח"כ תפענח את זה.
          3. ואם תרצה שיהיו רק 2 כפתורים במקום 3 או להיפך
            אתה צריך לעשות טופס דינאמי או להגדיר Visable לכל אחד ואז לסדר את המיקומים.

          אם יש לך משהו כזה דינאמי נשמח לקבל אותו.

          zvinissimZ מנותק
          zvinissimZ מנותק
          zvinissim
          כתב ב נערך לאחרונה על ידי
          #5

          @yits אמר בCustom MsgBox VBA:

          אם יש לך משהו כזה דינאמי נשמח לקבל אותו.

          זכור לי שפעם עשיתי משהו
          אני צריך לחפש

          אולי @clickone יודע

          פורום אופיס
          לכל הטיפים שלי

          תגובה 1 תגובה אחרונה
          1
          • חייםיודלביץח חייםיודלביץ

            @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

            אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
            שגיאה.png

            זה משה שעשיתי באקסס
            העתעקתי למודול חדש
            שמתי את הקוד הזה

            MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
            

            בלחצן ואז הוא כתב לי את השגיאה הנ"ל

            אשמח לעזרה
            תודה

            Y מנותק
            Y מנותק
            yits
            כתב ב נערך לאחרונה על ידי
            #6

            @חייםיודלביץ אמר בCustom MsgBox VBA:

            @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

            אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
            שגיאה.png

            זה משה שעשיתי באקסס
            העתעקתי למודול חדש
            שמתי את הקוד הזה

            MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
            

            בלחצן ואז הוא כתב לי את השגיאה הנ"ל

            אשמח לעזרה
            תודה

            איך קראת ל MsgBoxCB?
            אתה צריך גם לקבל תשובה מה המשתמש בחר,
            תעשה משתנה מסוג Long שמקבל את התשובה.

            לקניה והנחות ב KSP כנסו מכאן.
            למוצרים עם הנחה מכאן.

            WWWW חייםיודלביץח 2 תגובות תגובה אחרונה
            1
            • Y yits

              @חייםיודלביץ אמר בCustom MsgBox VBA:

              @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

              אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
              שגיאה.png

              זה משה שעשיתי באקסס
              העתעקתי למודול חדש
              שמתי את הקוד הזה

              MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
              

              בלחצן ואז הוא כתב לי את השגיאה הנ"ל

              אשמח לעזרה
              תודה

              איך קראת ל MsgBoxCB?
              אתה צריך גם לקבל תשובה מה המשתמש בחר,
              תעשה משתנה מסוג Long שמקבל את התשובה.

              WWWW מנותק
              WWWW מנותק
              WWW
              כתב ב נערך לאחרונה על ידי
              #7

              @yits אמר בCustom MsgBox VBA:

              @חייםיודלביץ אמר בCustom MsgBox VBA:

              @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

              אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
              שגיאה.png

              זה משה שעשיתי באקסס
              העתעקתי למודול חדש
              שמתי את הקוד הזה

              MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
              

              בלחצן ואז הוא כתב לי את השגיאה הנ"ל

              אשמח לעזרה
              תודה

              איך קראת ל MsgBoxCB?
              אתה צריך גם לקבל תשובה מה המשתמש בחר,
              תעשה משתנה מסוג Long שמקבל את התשובה.

              ואם אתה רוצה בלי קלט.
              אז תכתוב בלי סוגריים, כי אז זה יהיה פונקציה שלא מחזירה כלום.

              WWW.netfree@gmail.com || קשבק! החזר כספי לבנק על רכישות באינטרנט || עונים על סקרים ומרוויחים כסף!

              תגובה 1 תגובה אחרונה
              2
              • Y yits

                @חייםיודלביץ אמר בCustom MsgBox VBA:

                @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

                אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
                שגיאה.png

                זה משה שעשיתי באקסס
                העתעקתי למודול חדש
                שמתי את הקוד הזה

                MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
                

                בלחצן ואז הוא כתב לי את השגיאה הנ"ל

                אשמח לעזרה
                תודה

                איך קראת ל MsgBoxCB?
                אתה צריך גם לקבל תשובה מה המשתמש בחר,
                תעשה משתנה מסוג Long שמקבל את התשובה.

                חייםיודלביץח מנותק
                חייםיודלביץח מנותק
                חייםיודלביץ
                כתב ב נערך לאחרונה על ידי
                #8

                @yits אמר בCustom MsgBox VBA:

                @חייםיודלביץ אמר בCustom MsgBox VBA:

                @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

                אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
                שגיאה.png

                זה משה שעשיתי באקסס
                העתעקתי למודול חדש
                שמתי את הקוד הזה

                MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
                

                בלחצן ואז הוא כתב לי את השגיאה הנ"ל

                אשמח לעזרה
                תודה

                איך קראת ל MsgBoxCB?
                אתה צריך גם לקבל תשובה מה המשתמש בחר,
                תעשה משתנה מסוג Long שמקבל את התשובה.

                אכן חשבתי שלא צריך לרשום גם את MsgBox, עכשיו עובד, תודה זה מאד יעזור לי.

                @yits אמר בCustom MsgBox VBA:

                תעשה משתנה מסוג Long שמקבל את התשובה

                אשמח לדעת איך' אני אני לא יודע איך לעשות זאת
                תודה

                Y תגובה 1 תגובה אחרונה
                0
                • חייםיודלביץח חייםיודלביץ

                  @yits אמר בCustom MsgBox VBA:

                  @חייםיודלביץ אמר בCustom MsgBox VBA:

                  @yits תודה על השיתוף, אני חפשתי הרבה זמן כזה דבר ולא מצאתי משהו נורמלי, תודה!

                  אני מסתבך עם הקוד הוא כותב לי שגיאה כזאת
                  שגיאה.png

                  זה משה שעשיתי באקסס
                  העתעקתי למודול חדש
                  שמתי את הקוד הזה

                  MsgBoxCB("Message","Button1","Button2","Button3",vbMsgBoxRight or vbMsgBoxRtlReading, vbInformation, "Title")
                  

                  בלחצן ואז הוא כתב לי את השגיאה הנ"ל

                  אשמח לעזרה
                  תודה

                  איך קראת ל MsgBoxCB?
                  אתה צריך גם לקבל תשובה מה המשתמש בחר,
                  תעשה משתנה מסוג Long שמקבל את התשובה.

                  אכן חשבתי שלא צריך לרשום גם את MsgBox, עכשיו עובד, תודה זה מאד יעזור לי.

                  @yits אמר בCustom MsgBox VBA:

                  תעשה משתנה מסוג Long שמקבל את התשובה

                  אשמח לדעת איך' אני אני לא יודע איך לעשות זאת
                  תודה

                  Y מנותק
                  Y מנותק
                  yits
                  כתב ב נערך לאחרונה על ידי yits
                  #9

                  @חייםיודלביץ אמר בCustom MsgBox VBA:

                  @yits אמר בCustom MsgBox VBA:

                  תעשה משתנה מסוג Long שמקבל את התשובה

                  אשמח לדעת איך' אני אני לא יודע איך לעשות זאת
                  תודה

                  זה דוגמא שאני עשיתי Select Case

                  Select Case cMsgBox(cMsg.message, "נסה שנית", "חיבור מקומי", "יציאה", cMsg.ButtonsStyle, vbQuestion, cMsg.Title)
                      Case 1
                          Resume InternetConnection
                      Case 2
                          bLocalPc = True
                          Resume ReLink
                      Case 3
                          Resume AutoExec1_Exit
                  End Select
                  

                  לקניה והנחות ב KSP כנסו מכאן.
                  למוצרים עם הנחה מכאן.

                  חייםיודלביץח WWWW 2 תגובות תגובה אחרונה
                  2
                  • Y yits

                    @חייםיודלביץ אמר בCustom MsgBox VBA:

                    @yits אמר בCustom MsgBox VBA:

                    תעשה משתנה מסוג Long שמקבל את התשובה

                    אשמח לדעת איך' אני אני לא יודע איך לעשות זאת
                    תודה

                    זה דוגמא שאני עשיתי Select Case

                    Select Case cMsgBox(cMsg.message, "נסה שנית", "חיבור מקומי", "יציאה", cMsg.ButtonsStyle, vbQuestion, cMsg.Title)
                        Case 1
                            Resume InternetConnection
                        Case 2
                            bLocalPc = True
                            Resume ReLink
                        Case 3
                            Resume AutoExec1_Exit
                    End Select
                    
                    חייםיודלביץח מנותק
                    חייםיודלביץח מנותק
                    חייםיודלביץ
                    כתב ב נערך לאחרונה על ידי
                    #10

                    @yits תוך כדי שאני מנסה את זה בקוד ולא הולך לי אני רואה שכבר ערכת את ההודעה כדי שאני יבין יותר

                    תודה

                    תגובה 1 תגובה אחרונה
                    0
                    • Y yits

                      @חייםיודלביץ אמר בCustom MsgBox VBA:

                      @yits אמר בCustom MsgBox VBA:

                      תעשה משתנה מסוג Long שמקבל את התשובה

                      אשמח לדעת איך' אני אני לא יודע איך לעשות זאת
                      תודה

                      זה דוגמא שאני עשיתי Select Case

                      Select Case cMsgBox(cMsg.message, "נסה שנית", "חיבור מקומי", "יציאה", cMsg.ButtonsStyle, vbQuestion, cMsg.Title)
                          Case 1
                              Resume InternetConnection
                          Case 2
                              bLocalPc = True
                              Resume ReLink
                          Case 3
                              Resume AutoExec1_Exit
                      End Select
                      
                      WWWW מנותק
                      WWWW מנותק
                      WWW
                      כתב ב נערך לאחרונה על ידי
                      #11

                      @yits @חייםיודלביץ
                      עדיף עם משתנה.

                      msg = cMsgBox(cMsg.message, "נסה שנית", "חיבור מקומי", "יציאה", cMsg.ButtonsStyle, vbQuestion, cMsg.Title)
                      Select Case msg 
                                                      Case 1
                                                          Resume InternetConnection
                                                      Case 2
                                                          bLocalPc = True
                                                          Resume ReLink
                                                      Case 3
                                                          Resume AutoExec1_Exit
                                                  End Select
                      

                      WWW.netfree@gmail.com || קשבק! החזר כספי לבנק על רכישות באינטרנט || עונים על סקרים ומרוויחים כסף!

                      Y תגובה 1 תגובה אחרונה
                      3
                      • WWWW WWW

                        @yits @חייםיודלביץ
                        עדיף עם משתנה.

                        msg = cMsgBox(cMsg.message, "נסה שנית", "חיבור מקומי", "יציאה", cMsg.ButtonsStyle, vbQuestion, cMsg.Title)
                        Select Case msg 
                                                        Case 1
                                                            Resume InternetConnection
                                                        Case 2
                                                            bLocalPc = True
                                                            Resume ReLink
                                                        Case 3
                                                            Resume AutoExec1_Exit
                                                    End Select
                        
                        Y מנותק
                        Y מנותק
                        yits
                        כתב ב נערך לאחרונה על ידי
                        #12

                        @WWW @חייםיודלביץ
                        שים לב אני שיניתי את שם הפונציה מ MsgBoxCB ל cMsgBox

                        לקניה והנחות ב KSP כנסו מכאן.
                        למוצרים עם הנחה מכאן.

                        תגובה 1 תגובה אחרונה
                        1
                        • חייםיודלביץח מנותק
                          חייםיודלביץח מנותק
                          חייםיודלביץ
                          כתב ב נערך לאחרונה על ידי
                          #13

                          @yits הקוד חופשי לגמרי?

                          תודה

                          Y תגובה 1 תגובה אחרונה
                          0
                          • חייםיודלביץח חייםיודלביץ

                            @yits הקוד חופשי לגמרי?

                            תודה

                            Y מנותק
                            Y מנותק
                            yits
                            כתב ב נערך לאחרונה על ידי
                            #14

                            @חייםיודלביץ אמר בCustom MsgBox VBA:

                            @yits הקוד חופשי לגמרי?

                            תודה

                            כן

                            אני העתקתי אותו מכאן וקצת שיפרתי אותו.

                            ויש גם קלאסס מודול אחר, למי שמעוניין.

                            לקניה והנחות ב KSP כנסו מכאן.
                            למוצרים עם הנחה מכאן.

                            חנון המרבהח תגובה 1 תגובה אחרונה
                            1
                            • Y yits

                              @חייםיודלביץ אמר בCustom MsgBox VBA:

                              @yits הקוד חופשי לגמרי?

                              תודה

                              כן

                              אני העתקתי אותו מכאן וקצת שיפרתי אותו.

                              ויש גם קלאסס מודול אחר, למי שמעוניין.

                              חנון המרבהח מנותק
                              חנון המרבהח מנותק
                              חנון המרבה
                              כתב ב נערך לאחרונה על ידי חנון המרבה
                              #15

                              @yits איך אני משתמש למעשה עם התשובה של ה msgbox ?

                              ברגיל אני כותב

                              If משתנה = vbYes Then
                              

                              מה אני אמור לכתוב בmsgbox שלך ?!

                              WWWW תגובה 1 תגובה אחרונה
                              0
                              • חנון המרבהח חנון המרבה

                                @yits איך אני משתמש למעשה עם התשובה של ה msgbox ?

                                ברגיל אני כותב

                                If משתנה = vbYes Then
                                

                                מה אני אמור לכתוב בmsgbox שלך ?!

                                WWWW מנותק
                                WWWW מנותק
                                WWW
                                כתב ב נערך לאחרונה על ידי WWW
                                #16

                                @חנון-המרבה

                                If משתנה = 1 Then
                                

                                WWW.netfree@gmail.com || קשבק! החזר כספי לבנק על רכישות באינטרנט || עונים על סקרים ומרוויחים כסף!

                                חנון המרבהח תגובה 1 תגובה אחרונה
                                1
                                • WWWW WWW

                                  @חנון-המרבה

                                  If משתנה = 1 Then
                                  
                                  חנון המרבהח מנותק
                                  חנון המרבהח מנותק
                                  חנון המרבה
                                  כתב ב נערך לאחרונה על ידי
                                  #17

                                  @www מעולה.
                                  האם יש אפשרות שגם inputbox יהיה מימין לשמאל?!

                                  מלאמ תגובה 1 תגובה אחרונה
                                  0
                                  • חנון המרבהח חנון המרבה

                                    @www מעולה.
                                    האם יש אפשרות שגם inputbox יהיה מימין לשמאל?!

                                    מלאמ מנותק
                                    מלאמ מנותק
                                    מלא
                                    כתב ב נערך לאחרונה על ידי
                                    #18

                                    @חנון-המרבה
                                    לא

                                    חנון המרבהח תגובה 1 תגובה אחרונה
                                    0
                                    • מלאמ מלא

                                      @חנון-המרבה
                                      לא

                                      חנון המרבהח מנותק
                                      חנון המרבהח מנותק
                                      חנון המרבה
                                      כתב ב נערך לאחרונה על ידי
                                      #19

                                      @מלא מידיעה?!
                                      @WWW?
                                      @yits ?

                                      WWWW תגובה 1 תגובה אחרונה
                                      0
                                      • חנון המרבהח חנון המרבה

                                        @מלא מידיעה?!
                                        @WWW?
                                        @yits ?

                                        WWWW מנותק
                                        WWWW מנותק
                                        WWW
                                        כתב ב נערך לאחרונה על ידי
                                        #20

                                        @חנון-המרבה ?

                                        WWW.netfree@gmail.com || קשבק! החזר כספי לבנק על רכישות באינטרנט || עונים על סקרים ומרוויחים כסף!

                                        חנון המרבהח תגובה 1 תגובה אחרונה
                                        0
                                        • WWWW WWW

                                          @חנון-המרבה ?

                                          חנון המרבהח מנותק
                                          חנון המרבהח מנותק
                                          חנון המרבה
                                          כתב ב נערך לאחרונה על ידי
                                          #21

                                          @www האם יש אפשרות שגם inputbox יהיה מימין לשמאל?!

                                          WWWW תגובה 1 תגובה אחרונה
                                          0
                                          תגובה
                                          • תגובה כנושא
                                          התחברו כדי לפרסם תגובה
                                          • מהישן לחדש
                                          • מהחדש לישן
                                          • הכי הרבה הצבעות


                                          • 1
                                          • 2
                                          בא תתחבר לדף היומי!
                                          • התחברות

                                          • אין לך חשבון עדיין? הרשמה

                                          • התחברו או הירשמו כדי לחפש.
                                          • פוסט ראשון
                                            פוסט אחרון
                                          0
                                          • דף הבית
                                          • קטגוריות
                                          • פוסטים אחרונים
                                          • משתמשים
                                          • חיפוש
                                          • חוקי הפורום