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

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

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

Custom MsgBox VBA

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

    חיפשתי הרבה זמן איך אפשר להתאים אישית את הכפתורים ב 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")
    

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

    zvinissimZ חייםיודלביץח 2 תגובות תגובה אחרונה
    11
    • 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
                                          תגובה
                                          • תגובה כנושא
                                          התחברו כדי לפרסם תגובה
                                          • מהישן לחדש
                                          • מהחדש לישן
                                          • הכי הרבה הצבעות


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

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

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