Kết quả 1 đến 9 của 9

Chủ đề: Các hộp thoại và form người dùng

  1. #1
    banhmysaigon Guest

    Các hộp thoại và form người dùng

    Thay đổi các giá trị của một vài controls trên một form
    Đôi khi trong lập trình chúng ta còn lúng túng trong việc thay đổi giá trị cho hàng loại các controls trên một form. Ta có thể dùng hàm TypeName(control) để trả về tên của control đó trước khi chúng ta thay đổi giá trị của chúng.
    Các bạn tham khảo các đoạn mã sau:

    Mã:
    Thủ tục sau thay đổi các giá trị của CheckBox, trên UserForm1
    Sub ResetAllCheckBoxesInUserForm()
    Dim ctrl As Control
        For Each ctrl In UserForm1.Controls
            If TypeName(ctrl) = "CheckBox" Then
                ctrl.Value = False
            End If
        Next ctrl
    End Sub
    Thủ tục sau thay đổi các giá trị của OptionButton, trên UserForm1
    Sub ResetAllOptionButtonsInUserForm()
    Dim ctrl As Control
        For Each ctrl In UserForm1.Controls
            If TypeName(ctrl) = "OptionButton" Then
                ctrl.Value = False
            End If
        Next ctrl
    End Sub
    Thủ tục sau thay đổi các giá trị của TextBox, trên UserForm1 thành ""
    Sub ResetAllTextBoxesInUserForm()
    Dim ctrl As Control
        For Each ctrl In UserForm1.Controls
            If TypeName(ctrl) = "TextBox" Then
                ctrl.Text = ""
            End If
        Next ctrl
    End Sub
    Chú ý: tên control ở đây không phải là thuộc tính Name của control.



    Nguồn từ ERLANDSEN DATA CONSULTING.

    Lê Văn Duyệt

  2. #2
    lebachit Guest
    Chúng ta thường lẫn lộn InputBox Function (hàm) và InputBox Method.

    InputBox Function - Hàm InputBox

    Hàm này nhằm hiện ra hộp thoại, chờ người dùng nhập vào và Click nút lệnh. Hàm này sẽ trả về chuổi chứa trong textbox mà người dùng nhập vào.

    Cú pháp như sau:

    InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])

    _Prompt: là một chuổi ký tự thể hiện khi hộp thoại hiện ra.

    Số ký tự tối đa có thể lên đến 1024. Nếu chuổi ký tự này quá dài các bạn có thể dùng Chr(13) để xuống hàng, Chr(10) để tách các ký tự ra hàng khác.
    _Tilte: đầu đề của hộp thoại.
    _Default: giá trị mặc định.
    _xpos, ypos: vị trí thể hiện hộp thoại. (Đvt: Twips)
    _Helpfile
    _Context
    Khi bạn cung cấp Helpfile context file thì người dùng có thể nhấn phím F1 để được hướng dẫn dựa trên thông tin này.

    Đây là đoạn mã ví dụ của VBA

    Mã:
    Sub test()
        Dim Message, Title, Default, MyValue
        Message = "Enter a value between 1 and 3"    ' Hiện hộp thoại.
        Title = "InputBox Demo"    ' Set title.
        Default = "1"    ' Thiết lập giá trị mặc định.
        ' Display message, title, and default value.
        MyValue = InputBox(Message, Title, Default)
    End Sub
    Và hộp thoại hiện ra như sau:




    InputBox Method - Phương thức InputBox

    Hiện hộp thoại để người dùng nhập liệu.

    Cú pháp như sau:

    Expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
    _Expression: là Application.
    _Prompt: là một chuổi ký tự thể hiện khi hộp thoại hiện ra. Có thể là kiểu chuổi, số, ngày, hay boolean.
    _Title/Default/Left/Top/Helpfile/HelpContextID: tương tự như hàm InputBox.
    _Type: Chỉ định kiểu dữ liệu trả về.

    Mã:
    Value     Meaning 
    Giá trị    Ý nghĩa
    0          Công thức
    1          Số
    2          Chuổi ký tự
    4          Kiểu luận lý
    8          Ô tham chiếu đến (như đối tượng Range)
    16         Một giá trị lỗi như #N/A
    64         An array of values
    Vậy chúng ta thấy sự khác nhau ở Type: Chỉ định kiểu dữ liệu trả về

    Sử dụng phương thức Application.InputBox thì hơn ở chỗ là áp được kiểu của người dùng nhập vào do đó không cần phải xử lý về kiểu nữa.

    Một ví dụ so sánh từ trang Erlandsen Data Consulting

    Mã:
    Sub DecideUserInput()
        Dim bText As String, bNumber As Integer
        ' Đây là hàm INPUTBOX :
        bText = InputBox("Insert in a text", "This accepts any input")
        ' Đây là phương thức INPUTBOX :
        bNumber = Application.InputBox("Insert a number", "This accepts numbers only", , , , , , 1)
        MsgBox "You have inserted :" & Chr(13) & _
               bText & Chr(13) & bNumber, , "Result from INPUT-boxes"
    End Sub
    Một vấn đề chúng ta cần quan tâm là khi dùng phương thức Application.InputBox, làm sao phân biệt được nếu người dùng nhấn nút Cancel và nếu người dùng nhập vào chuỗi "Cancel".
    Khi đó chúng ta kết hợp hàm TypeNamexét chiều dài của chuổi ký tự

    Mã:
    Sub Test()
        Dim Text ' As String
        Text = Application.InputBox("Gõ gì đó vào đây!", Type:=2) 'Type:=2, tức là kiểu chuổi
        If Len(Text) > 0 And TypeName(Text) = "String" Then
            MsgBox Text
        End If
    End Sub
    Tham khảo topic tại đây.

    Đối với những trường hợp khác thì chúng ta phải xét tùy trường hợp cụ thể. Có thể nói đây là vấn đề cũng phức tạp không kém.

    Tham khảo thêm trên trang của Microsoft Support.


    Lê Văn Duyệt

  3. #3
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Trên diễn đàn có rất nhiều bạn thắc mắc về vấn đề này, và bài này cũng đã có nhiều bạn đưa lên diễn đàn. Hôm nay tôi xin đưa code vào thư viện, nhằm giúp cho các bạn dễ tìm kiếm.
    Để thao tác với form trong VBA chúng ta thông qua Class Module sau:

    Mã:
    '***************************************************************************
    '*
    '* MODULE NAME:     USERFORM WINDOW STYLES
    '* AUTHOR:          STEPHEN BULLEN, Office Automation Ltd.
    '*                  TIM CLEM
    '*
    '* CONTACT:         Stephen@oaltd.co.uk
    '* WEB SITE:        http://www.oaltd.co.uk
    '*
    '* DESCRIPTION:     Changes userform's window styles to give different visual effects
    '*
    '* THIS MODULE:     Changes the userform's styles so it can be resized/maximised/minimized, etc.
    '*                  The code was initially created by Tim Clem, and expanded by Stephen Bullen.
    '*
    '* UPDATES:
    '*  DATE            COMMENTS
    '*  11 Jan 2005     Changed the way 'ShowInTaskBar' works, fixing a bug found by Jamie Collins
    '*
    '***************************************************************************
    
    Option Explicit
    
    'Windows API calls to do all the dirty work!
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
    
    'Lots of window styles for us to play with!
    Private Const GWL_STYLE As Long = (-16)          'The offset of a window's style
    Private Const GWL_EXSTYLE As Long = (-20)        'The offset of a window's extended style
    Private Const WS_CAPTION As Long = &HC00000      'Style to add a titlebar
    Private Const WS_SYSMENU As Long = &H80000       'Style to add a system menu
    Private Const WS_THICKFRAME As Long = &H40000    'Style to add a sizable frame
    Private Const WS_MINIMIZEBOX As Long = &H20000   'Style to add a Minimize box on the title bar
    Private Const WS_MAXIMIZEBOX As Long = &H10000   'Style to add a Maximize box to the title bar
    Private Const WS_EX_APPWINDOW As Long = &H40000  'Application Window: shown on taskbar
    Private Const WS_EX_TOOLWINDOW As Long = &H80    'Tool Window: small titlebar
    
    'Constant to identify the Close menu item
    Private Const SC_CLOSE As Long = &HF060
    
    'Constants for hide or show a window
    Private Const SW_HIDE As Long = 0
    Private Const SW_SHOW As Long = 5
    
    'Constants for Windows messages
    Private Const WM_SETICON = &H80
    
    'Variables to store the various selections/options
    Dim mbSizeable As Boolean, mbCaption As Boolean, mbIcon As Boolean
    Dim mbMaximize As Boolean, mbMinimize As Boolean, mbSysMenu As Boolean, mbCloseBtn As Boolean
    Dim mbAppWindow As Boolean, mbToolWindow As Boolean, mbModal As Boolean
    Dim msIconPath As String
    Dim moForm As Object
    Dim mhWndForm As Long
    
    'Set the class's initial properties to be those of a default userform
    Private Sub Class_Initialize()
        mbCaption = True
        mbSysMenu = True
        mbCloseBtn = True
    End Sub
    
    'Allow the calling code to tell us which form to handle
    Public Property Set Form(oForm As Object)
    
        'Get the userform's window handle
        If Val(Application.Version) < 9 Then
            mhWndForm = FindWindow("ThunderXFrame", oForm.Caption)    'XL97
        Else
            mhWndForm = FindWindow("ThunderDFrame", oForm.Caption)    'XL2000+
        End If
    
        'Remember the form for later
        Set moForm = oForm
    
        'Set the form's style
        SetFormStyle
    
        'Update the form's icon
        ChangeIcon
    
        'Update the taskbar visibility
        If mbAppWindow Then ShowTaskBarIcon = True
    
    End Property
    
    '***************************************************************
    '* Property procedures to get and set the form's window styles
    '***************************************************************
    
    Public Property Let Modal(bModal As Boolean)
        mbModal = bModal
    
        'Make the form modal or modeless by enabling/disabling Excel itself
        EnableWindow FindWindow("XLMAIN", Application.Caption), Abs(CInt(Not mbModal))
    End Property
    
    Public Property Get Modal() As Boolean
        Modal = mbModal
    End Property
    
    Public Property Let Sizeable(bSizeable As Boolean)
        mbSizeable = bSizeable
        SetFormStyle
    End Property
    
    Public Property Get Sizeable() As Boolean
        Sizeable = mbSizeable
    End Property
    
    Public Property Let ShowCaption(bCaption As Boolean)
        mbCaption = bCaption
        SetFormStyle
    End Property
    
    Public Property Get ShowCaption() As Boolean
        ShowCaption = mbCaption
    End Property
    
    Public Property Let SmallCaption(bToolWindow As Boolean)
        mbToolWindow = bToolWindow
        SetFormStyle
    End Property
    
    Public Property Get SmallCaption() As Boolean
        SmallCaption = mbToolWindow
    End Property
    
    Public Property Let ShowMaximizeBtn(bMaximize As Boolean)
        mbMaximize = bMaximize
        SetFormStyle
    End Property
    
    Public Property Get ShowMaximizeBtn() As Boolean
        ShowMaximizeBtn = mbMaximize
    End Property
    
    Public Property Let ShowMinimizeBtn(bMinimize As Boolean)
        mbMinimize = bMinimize
        SetFormStyle
    End Property
    
    Public Property Get ShowMinimizeBtn() As Boolean
        ShowMinimizeBtn = mbMinimize
    End Property
    
    Public Property Let ShowSysMenu(bSysMenu As Boolean)
        mbSysMenu = bSysMenu
        SetFormStyle
    End Property
    
    Public Property Get ShowSysMenu() As Boolean
        ShowSysMenu = mbSysMenu
    End Property
    
    Public Property Let ShowCloseBtn(bCloseBtn As Boolean)
        mbCloseBtn = bCloseBtn
        SetFormStyle
    End Property
    
    Public Property Get ShowCloseBtn() As Boolean
        ShowCloseBtn = mbCloseBtn
    End Property
    
    Public Property Let ShowTaskBarIcon(bAppWindow As Boolean)
    
        mbAppWindow = bAppWindow
    
        'When showing/hiding the task bar icon, we have to hide and reshow the form
        'to get Windows to update the task bar
        If mhWndForm <> 0 Then
            'Freeze the form, to avoid flicker when hiding/showing it
            LockWindowUpdate mhWndForm
    
            'Enable the Excel window, so we don't lose focus
            EnableWindow FindWindow("XLMAIN", Application.Caption), True
    
            'Hide the form
            ShowWindow mhWndForm, SW_HIDE
    
            'Update the style bits
            SetFormStyle
    
            'Reshow the userform
            ShowWindow mhWndForm, SW_SHOW
    
            'Unfreeze the form
            LockWindowUpdate 0&
    
            'Set the Excel window's enablement to the correct choice
            EnableWindow FindWindow("XLMAIN", Application.Caption), Abs(CInt(Not mbModal))
        End If
    
    End Property
    
    Public Property Get ShowTaskBarIcon() As Boolean
        ShowTaskBarIcon = mbAppWindow
    End Property
    
    Public Property Let ShowIcon(bIcon As Boolean)
        mbIcon = Not bIcon
        ChangeIcon
        SetFormStyle
    End Property
    
    Public Property Get ShowIcon() As Boolean
        ShowIcon = (mbIcon <> 1)
    End Property
    
    Public Property Let IconPath(sNewPath As String)
        msIconPath = sNewPath
        ChangeIcon
        SetFormStyle
    End Property
    
    Public Property Get IconPath() As String
        IconPath = msIconPath
    End Property

  4. #4
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Mã:
    '***************************************************************
    '* Private procedures to perform the updates
    '***************************************************************
    
    'Procedure to set the form's window style
    Private Sub SetFormStyle()
    
        Dim lStyle As Long, hMenu As Long
    
        'Have we got a form to set?
        If mhWndForm = 0 Then Exit Sub
    
        'Get the basic window style
        lStyle = GetWindowLong(mhWndForm, GWL_STYLE)
    
        'Build up the basic window style flags for the form
        SetBit lStyle, WS_CAPTION, mbCaption
        SetBit lStyle, WS_SYSMENU, mbSysMenu
        SetBit lStyle, WS_THICKFRAME, mbSizeable
        SetBit lStyle, WS_MINIMIZEBOX, mbMinimize
        SetBit lStyle, WS_MAXIMIZEBOX, mbMaximize
        
        'Set the basic window styles
        SetWindowLong mhWndForm, GWL_STYLE, lStyle
    
        'Get the extended window style
        lStyle = GetWindowLong(mhWndForm, GWL_EXSTYLE)
    
        'Build up and set the extended window style
        SetBit lStyle, WS_EX_APPWINDOW, mbAppWindow
        SetBit lStyle, WS_EX_TOOLWINDOW, mbToolWindow
        
        SetWindowLong mhWndForm, GWL_EXSTYLE, lStyle
    
        'Handle the close button differently
        If mbCloseBtn Then
            'We want it, so reset the control menu
            hMenu = GetSystemMenu(mhWndForm, 1)
        Else
            'We don't want it, so delete it from the control menu
            hMenu = GetSystemMenu(mhWndForm, 0)
            DeleteMenu hMenu, SC_CLOSE, 0&
        End If
    
        'Update the window with the changes
        DrawMenuBar mhWndForm
        SetFocus mhWndForm
    
    End Sub
    
    'Procedure to set or clear a bit from a style flag
    Private Sub SetBit(ByRef lStyle As Long, ByVal lBit As Long, ByVal bOn As Boolean)
        If bOn Then
            lStyle = lStyle Or lBit
        Else
            lStyle = lStyle And Not lBit
        End If
    End Sub
    
    'Procedure to set the form's icon
    Private Sub ChangeIcon()
    
        Dim hIcon As Long
    
        On Error Resume Next
    
        If mhWndForm <> 0 Then
    
            Err.Clear
            If msIconPath = "" Then
                hIcon = 0
            ElseIf Dir(msIconPath) = "" Then
                hIcon = 0
            ElseIf Err.Number <> 0 Then
                hIcon = 0
            ElseIf Not mbIcon Then
                'Get the icon from the source
                hIcon = ExtractIcon(0, msIconPath, 0)
            Else
                hIcon = 0
            End If
    
            'Set the big (32x32) and small (16x16) icons
            SendMessage mhWndForm, WM_SETICON, True, hIcon
            SendMessage mhWndForm, WM_SETICON, False, hIcon
        End If
    
    End Sub
    Tác giả đã đưa ra ví dụ thông qua một form trong VBA, form được thiết kế gồm các control như hình sau:



    Sau đây là các hình dạng form khi chúng ta chọn thông qua các Checkbox

    Hình 1


    Hình 2


    Hình 3


    Hình 4


    Hình 5


    Hình 6


    Hình 7


    Lê Văn Duyệt

  5. #5
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    _ Nếu các bạn quan tâm tại sao lại làm được như vậy? Các bạn có thể đọc code của Class Module trên. Tác giả đã dùng các hàm API để thao tác với form trong VBA.
    _ Nếu các bạn không quan tâm mà chỉ biết sử dụng Class trên như thế nào thì hãy theo tôi

    Đầu tiên trong UserForm bạn khai báo biến như sau:


    Mã:
    Option Explicit
    'Declare a new instance of our form changer class
    'Khai báo biến sẽ được dùng cho class module CFormChanger
    Dim mclsFormChanger As CFormChanger
    Thủ tục sự kiện khi form Activate


    Mã:
    Private Sub UserForm_Activate()
        'Giành một vùng nhớ cho biến
        Set mclsFormChanger = New CFormChanger
    
        'Initialise to be like a 'standard' userform
        'Thiết lập các checkbox
        cbModal.Value = True
        cbCaption.Value = True
        cbCloseBtn.Value = True
        cbTaskBar.Value = True
        cbIcon.Value = False
        cbMaximize.Value = False
        cbMinimize.Value = False
        cbSizeable.Value = False
        cbSysmenu.Value = True
        cbTaskBar.Value = False
        cbSmallCaption.Value = False
    
        'Set the form changer to change this userform
        'Thiết lập biến cho UserForm
        Set mclsFormChanger.Form = Me
    
        'Make sure everything is in the right place to start with
        'Chắc chắn các control ở đúng vị trí, xin các bạn xem thủ tục UserForm_Resize
        UserForm_Resize
    
    End Sub
    Thủ tục UserForm_Resize()
    Các bạn tự tìm hiểu thủ tục này, thủ tục này chủ yếu là sắp xếp lại các control khi form được thay đổi kích thước.

    Mã:
    Private Sub UserForm_Resize()
    
        Dim dFrameCols As Double, dFrameRows As Double, dFrameHeight As Double
        Dim i As Integer, j As Integer
    
        'Standard control gap of 6pts
        Const dGAP As Integer = 6
    
        'Exit the sub if we've been minimized
        If Me.InsideWidth = 0 Then Exit Sub
    
        'Set controls that don't move/size
        With lblMessage                              'The position of the "Message" label
            .Top = dGAP
            .Left = dGAP
        End With
    
        With tbMessage                               'The position of the message box (the size changes, not the position)
            .Top = dGAP + lblMessage.Height + dGAP
            .Left = dGAP
        End With
    
        fraStyle.Left = dGAP
    
        'Don't let the form get less than a certain height - must have at least the message and button
        If Me.InsideHeight < lblMessage.Height + btnOK.Height + fraStyle.Height + dGAP * 5 Then
    
            'Reset the height, allowing for the form's border (Height - InsideHeight)
            Me.Height = lblMessage.Height + btnOK.Height + fraStyle.Height + dGAP * 5 + Me.Height - Me.InsideHeight
        End If
    
        'Don't let the form get less than a certain width - must be as wide as the biggest check box, plus the standard gap
        If Me.InsideWidth < cbMaximize.Width + fraStyle.Width - fraStyle.InsideWidth + dGAP * 4 Then
    
            'Reset the width, allowing for the form's border (Width - InsideWidth)
            Me.Width = cbMaximize.Width + fraStyle.Width - fraStyle.InsideWidth + dGAP * 4
        End If
    
        'Work out the new dimensions of the frame (as the check boxes move within the frame)
        With fraStyle
            dFrameCols = Application.Max(1, (Me.InsideWidth - dGAP * 3 - (.Width - .InsideWidth)) \ (cbMaximize.Width + dGAP))
            dFrameRows = .Controls.Count / dFrameCols
    
            If dFrameRows <> Int(dFrameRows) Then dFrameRows = Int(dFrameRows) + 1
            dFrameHeight = dFrameRows * cbMaximize.Height + dGAP + .Height - .InsideHeight
        End With
    
        'Don't allow the form width to decrease so that there's no room for the checkboxes
        'i.e. decreasing the width causes the check boxes to require an extra row, which doesn't fit.
        If Me.InsideHeight <= btnOK.Height + lblMessage.Height + dFrameHeight + dGAP * 5 Then
    
            'Reset the width, allowing for the form's border (Width - InsideWidth)
            Me.Width = fraStyle.Width + dGAP * 2 + Me.Width - Me.InsideWidth
    
            'Recalculate the frame's dimensions with the changed form's width
            With fraStyle
                dFrameCols = Application.Max(1, (Me.InsideWidth - dGAP * 3 - (.Width - .InsideWidth)) \ (cbMaximize.Width + dGAP))
                dFrameRows = .Controls.Count / dFrameCols
    
                If dFrameRows <> Int(dFrameRows) Then dFrameRows = Int(dFrameRows) + 1
                dFrameHeight = dFrameRows * cbMaximize.Height + dGAP + .Height - .InsideHeight
            End With
    
        End If
    
        'Set the OK button to be in the middle at the bottom
        With btnOK
            .Left = (Me.InsideWidth - btnOK.Width) / 2
            .Top = Me.InsideHeight - btnOK.Height - dGAP
        End With
    
        'Sometimes the OK button leaves white lines from its edges, so use a label to clear them
        With lblBlank
            .Width = Me.InsideWidth
            .Top = btnOK.Top - 0.75
        End With
    
        'Set the frame to be as wide as the box and move the check boxes in it to fit
        With fraStyle
            .Width = Me.InsideWidth - dGAP * 2
            .Height = dFrameHeight
    
            'Reposition the controls in the frame, according to their tab order
            For i = 0 To .Controls.Count - 1
                For j = 0 To .Controls.Count - 1
                    With .Controls(j)
                        If .TabIndex = i Then
                            .Left = (i Mod dFrameCols) * (cbMaximize.Width + dGAP) + dGAP
                            .Top = Int(i / dFrameCols) * cbMaximize.Height + dGAP
                        End If
                    End With
                Next
            Next
    
            .Top = btnOK.Top - dGAP - .Height
        End With
    
        'Userform is big enough, so set the message box's height and width to fill it
        With tbMessage
            .Width = Me.InsideWidth - dGAP * 2
    
            'Don't allow the height to go negative
            .Height = Application.Max(0, fraStyle.Top - .Top - dGAP)
        End With
    End Sub
    Thủ tục UserForm_QueryClose chủ yếu không cho người dùng đóng bằng nút X trên form


    Mã:
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        'If we've disabled the [x] close button, prevent the Alt+F4 keyboard shortcut too Không cho phép ngay cả khi người dùng nhấn tổ hợp Alt + F4
        If CloseMode = vbFormControlMenu And Not cbCloseBtn.Value Then
            Cancel = True
        End If
    End Sub
    Thủ tục Sub UserForm_Terminate()
    Nhằm giải phóng bộ nhớ cho biến mclsFormChanger

    Mã:
    Private Sub UserForm_Terminate()
        Set mclsFormChanger = Nothing
    End Sub
    Ngoài ra trong form này chúng ta còn các thủ tục khác, khi người dùng click vào các nút CheckBox:

    Mã:
    Private Sub cbModal_Change()
        mclsFormChanger.Modal = cbModal.Value
        CheckEnabled
    End Sub
    
    Private Sub cbSizeable_Change()
        mclsFormChanger.Sizeable = cbSizeable.Value
    
        CheckBorderStyle
    End Sub
    
    Private Sub cbCaption_Change()
        mclsFormChanger.ShowCaption = cbCaption.Value
    
        CheckBorderStyle
        CheckEnabled
    End Sub
    
    Private Sub cbSmallCaption_Change()
        mclsFormChanger.SmallCaption = cbSmallCaption.Value
        CheckEnabled
    End Sub
    
    Private Sub cbTaskBar_Change()
        mclsFormChanger.ShowTaskBarIcon = cbTaskBar.Value
        CheckEnabled
    End Sub
    
    Private Sub cbSysmenu_Change()
        mclsFormChanger.ShowSysMenu = cbSysmenu.Value
        CheckEnabled
    End Sub
    
    Private Sub cbIcon_Change()
        mclsFormChanger.ShowIcon = cbIcon.Value
        If cbIcon.Value And mclsFormChanger.IconPath = "" Then btnChangeIcon_Click
        CheckEnabled
    End Sub
    
    Private Sub btnChangeIcon_Click()
    
        Dim vFile As Variant
    
        vFile = Application.GetOpenFilename("Icon files (*.ico;*.exe;*.dll),*.ico;*.exe;*.dll", 0, "Open Icon File", "Open", False)
    
        'Showing dialog sets the form modeless, so check it
        mclsFormChanger.Modal = cbModal
    
        If vFile = False Then Exit Sub
    
        mclsFormChanger.IconPath = vFile
    
    End Sub
    
    Private Sub cbCloseBtn_Change()
        mclsFormChanger.ShowCloseBtn = cbCloseBtn.Value
        CheckEnabled
    End Sub
    
    Private Sub cbMinimize_Change()
        mclsFormChanger.ShowMinimizeBtn = cbMinimize.Value
        CheckEnabled
    End Sub
    
    Private Sub cbMaximize_Change()
        mclsFormChanger.ShowMaximizeBtn = cbMaximize.Value
        CheckEnabled
    End Sub
    
    Private Sub btnOK_Click()
        Unload Me
    End Sub
    
    Private Sub CheckBorderStyle()
    
        'If the userform is not sizeable and doesn't have a caption,
        'Windows draws it without a border, and we need to apply our
        'own 3D effect.
        If Not (cbSizeable Or cbCaption) Then
            Me.SpecialEffect = fmSpecialEffectRaised
        Else
            Me.SpecialEffect = fmSpecialEffectFlat
        End If
    
    End Sub
    
    Private Sub CheckEnabled()
    
        'Without a system menu, we can't have the close, max or min buttons
        cbSysmenu.Enabled = cbCaption
        cbCloseBtn.Enabled = cbSysmenu And cbCaption
        cbIcon.Enabled = cbSysmenu And cbCaption And Not cbSmallCaption
        cbMaximize.Enabled = cbSysmenu And cbCaption And Not cbSmallCaption
        cbMinimize.Enabled = cbSysmenu And cbCaption And Not cbSmallCaption
    
        btnChangeIcon.Enabled = cbIcon.Value And cbIcon.Enabled
    
    End Sub
    Với việc giải thích sơ bộ như trên tôi hy vọng các bạn mới làm quen với Class Module có thể dùng Class Module này cho ứng dụng của mình.
    Các bạn có thể tham khảo bài vết về Class Module của các bạn trên diễn đàn.

    Lê Văn Duyệt

  6. #6
    daocba Guest
    Tôi xin dùng module của Nguyen Duy Tuan, và cùng phân tích với các bạn:

    Module của Tuan như sau:


    Mã:
    '****************************************
    'Tac gia: Nguyen Duy Tuan
    'Tel    : 0904.210.337
    'E.Mail : tuanktcdcn@yahoo.com
    'Website: www.bluesofts.net
    '****************************************
    'Khai báo các hàm API trong thư viện User32.DLL
    
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    
    Function MsgBoxUni(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant = vbNullString) As VbMsgBoxResult
    
    'BStrMsg,BStrTitle : Là chuổi Unicode
    Dim BStrMsg, BStrTitle
        'Hàm StrConv Chuyển chuổi về mã Unicode
        BStrMsg = StrConv(PromptUni, vbUnicode)
        BStrTitle = StrConv(TitleUni, vbUnicode)
        'Hiện thông báo
        MsgBoxUni = MessageBoxW(GetActiveWindow, BStrMsg, BStrTitle, Buttons)
    End Function
    
    '==================================================================
    'Hàm TCVN3toUNICODE, VNItoUNICODE được viết bởi Bình - OverAC
    'www.giaiphapexcel.com
    Function TCVN3toUNICODE(vnstr As String)
    Dim c As String, i As Integer
        For i = 1 To Len(vnstr)
            c = Mid(vnstr, i, 1)
            Select Case c
            Case "a": c = ChrW$(97)
            Case "¸": c = ChrW$(225)
            Case "µ": c = ChrW$(224)
            Case "¶": c = ChrW$(7843)
            Case "·": c = ChrW$(227)
            Case "¹": c = ChrW$(7841)
            Case "¨": c = ChrW$(259)
            Case "¾": c = ChrW$(7855)
            Case "»": c = ChrW$(7857)
            Case "¼": c = ChrW$(7859)
            Case "½": c = ChrW$(7861)
            Case "Æ": c = ChrW$(7863)
            Case "©": c = ChrW$(226)
            Case "Ê": c = ChrW$(7845)
            Case "Ç": c = ChrW$(7847)
            Case "È": c = ChrW$(7849)
            Case "É": c = ChrW$(7851)
            Case "Ë": c = ChrW$(7853)
            Case "e": c = ChrW$(101)
            Case "Ð": c = ChrW$(233)
            Case "Ì": c = ChrW$(232)
            Case "Î": c = ChrW$(7867)
            Case "Ï": c = ChrW$(7869)
            Case "Ñ": c = ChrW$(7865)
            Case "ª": c = ChrW$(234)
            Case "Õ": c = ChrW$(7871)
            Case "Ò": c = ChrW$(7873)
            Case "Ó": c = ChrW$(7875)
            Case "Ô": c = ChrW$(7877)
            Case "Ö": c = ChrW$(7879)
            Case "o": c = ChrW$(111)
            Case "ã": c = ChrW$(243)
            Case "ß": c = ChrW$(242)
            Case "á": c = ChrW$(7887)
            Case "â": c = ChrW$(245)
            Case "ä": c = ChrW$(7885)
            Case "«": c = ChrW$(244)
            Case "è": c = ChrW$(7889)
            Case "å": c = ChrW$(7891)
            Case "æ": c = ChrW$(7893)
            Case "ç": c = ChrW$(7895)
            Case "é": c = ChrW$(7897)
            Case "¬": c = ChrW$(417)
            Case "í": c = ChrW$(7899)
            Case "ê": c = ChrW$(7901)
            Case "ë": c = ChrW$(7903)
            Case "ì": c = ChrW$(7905)
            Case "î": c = ChrW$(7907)
            Case "i": c = ChrW$(105)
            Case "Ý": c = ChrW$(237)
            Case "×": c = ChrW$(236)
            Case "Ø": c = ChrW$(7881)
            Case "Ü": c = ChrW$(297)
            Case "Þ": c = ChrW$(7883)
            Case "u": c = ChrW$(117)
            Case "ó": c = ChrW$(250)
            Case "ï": c = ChrW$(249)
            Case "ñ": c = ChrW$(7911)
            Case "ò": c = ChrW$(361)
            Case "ô": c = ChrW$(7909)
            Case "­": c = ChrW$(432)
            Case "ø": c = ChrW$(7913)
            Case "õ": c = ChrW$(7915)
            Case "ö": c = ChrW$(7917)
            Case "÷": c = ChrW$(7919)
            Case "ù": c = ChrW$(7921)
            Case "y": c = ChrW$(121)
            Case "ý": c = ChrW$(253)
            Case "ú": c = ChrW$(7923)
            Case "û": c = ChrW$(7927)
            Case "ü": c = ChrW$(7929)
            Case "þ": c = ChrW$(7925)
            Case "®": c = ChrW$(273)
            Case "A": c = ChrW$(65)
            Case "¡": c = ChrW$(258)
            Case "¢": c = ChrW$(194)
            Case "E": c = ChrW$(69)
            Case "£": c = ChrW$(202)
            Case "O": c = ChrW$(79)
            Case "¤": c = ChrW$(212)
            Case "¥": c = ChrW$(416)
            Case "I": c = ChrW$(73)
            Case "U": c = ChrW$(85)
            Case "¦": c = ChrW$(431)
            Case "Y": c = ChrW$(89)
            Case "§": c = ChrW$(272)
            End Select
            TCVN3toUNICODE = TCVN3toUNICODE + c
        Next i
    End Function
    LVD

  7. #7
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Mã:
    Function VNItoUNICODE(vnstr As String)
    Dim c As String, i As Integer
    Dim db         As Boolean
        For i = 1 To Len(vnstr)
            db = False
            If i < Len(vnstr) Then
                c = Mid(vnstr, i + 1, 1)
                If c = "ù" Or c = "ø" Or c = "û" Or c = "õ" Or c = "ï" Or _
                   c = "ê" Or c = "é" Or c = "è" Or c = "ú" Or c = "ü" Or c = "ë" Or _
                   c = "â" Or c = "á" Or c = "à" Or c = "å" Or c = "ã" Or c = "ä" Or _
                   c = "Ù" Or c = "Ø" Or c = "Û" Or c = "Õ" Or c = "Ï" Or _
                   c = "Ê" Or c = "É" Or c = "È" Or c = "Ú" Or c = "Ü" Or c = "Ë" Or _
                   c = "Â" Or c = "Á" Or c = "À" Or c = "Å" Or c = "Ã" Or c = "Ä" Then db = True
            End If
            If db Then
                c = Mid(vnstr, i, 2)
                Select Case c
                Case "aù": c = ChrW$(225)
                Case "aø": c = ChrW$(224)
                Case "aû": c = ChrW$(7843)
                Case "aõ": c = ChrW$(227)
                Case "aï": c = ChrW$(7841)
                Case "aê": c = ChrW$(259)
                Case "aé": c = ChrW$(7855)
                Case "aè": c = ChrW$(7857)
                Case "aú": c = ChrW$(7859)
                Case "aü": c = ChrW$(7861)
                Case "aë": c = ChrW$(7863)
                Case "aâ": c = ChrW$(226)
                Case "aá": c = ChrW$(7845)
                Case "aà": c = ChrW$(7847)
                Case "aå": c = ChrW$(7849)
                Case "aã": c = ChrW$(7851)
                Case "aä": c = ChrW$(7853)
                Case "eù": c = ChrW$(233)
                Case "eø": c = ChrW$(232)
                Case "eû": c = ChrW$(7867)
                Case "eõ": c = ChrW$(7869)
                Case "eï": c = ChrW$(7865)
                Case "eâ": c = ChrW$(234)
                Case "eá": c = ChrW$(7871)
                Case "eà": c = ChrW$(7873)
                Case "eå": c = ChrW$(7875)
                Case "eã": c = ChrW$(7877)
                Case "eä": c = ChrW$(7879)
                Case "où": c = ChrW$(243)
                Case "oø": c = ChrW$(242)
                Case "oû": c = ChrW$(7887)
                Case "oõ": c = ChrW$(245)
                Case "oï": c = ChrW$(7885)
                Case "oâ": c = ChrW$(244)
                Case "oá": c = ChrW$(7889)
                Case "oà": c = ChrW$(7891)
                Case "oå": c = ChrW$(7893)
                Case "oã": c = ChrW$(7895)
                Case "oä": c = ChrW$(7897)
                Case "ôù": c = ChrW$(7899)
                Case "ôø": c = ChrW$(7901)
                Case "ôû": c = ChrW$(7903)
                Case "ôõ": c = ChrW$(7905)
                Case "ôï": c = ChrW$(7907)
                Case "uù": c = ChrW$(250)
                Case "uø": c = ChrW$(249)
                Case "uû": c = ChrW$(7911)
                Case "uõ": c = ChrW$(361)
                Case "uï": c = ChrW$(7909)
                Case "öù": c = ChrW$(7913)
                Case "öø": c = ChrW$(7915)
                Case "öû": c = ChrW$(7917)
                Case "öõ": c = ChrW$(7919)
                Case "öï": c = ChrW$(7921)
                Case "yù": c = ChrW$(253)
                Case "yø": c = ChrW$(7923)
                Case "yû": c = ChrW$(7927)
                Case "yõ": c = ChrW$(7929)
                Case "AÙ": c = ChrW$(193)
                Case "AØ": c = ChrW$(192)
                Case "AÛ": c = ChrW$(7842)
                Case "AÕ": c = ChrW$(195)
                Case "AÏ": c = ChrW$(7840)
                Case "AÊ": c = ChrW$(258)
                Case "AÉ": c = ChrW$(7854)
                Case "AÈ": c = ChrW$(7856)
                Case "AÚ": c = ChrW$(7858)
                Case "AÜ": c = ChrW$(7860)
                Case "AË": c = ChrW$(7862)
                Case "AÂ": c = ChrW$(194)
                Case "AÁ": c = ChrW$(7844)
                Case "AÀ": c = ChrW$(7846)
                Case "AÅ": c = ChrW$(7848)
                Case "AÃ": c = ChrW$(7850)
                Case "AÄ": c = ChrW$(7852)
                Case "EÙ": c = ChrW$(201)
                Case "EØ": c = ChrW$(200)
                Case "EÛ": c = ChrW$(7866)
                Case "EÕ": c = ChrW$(7868)
                Case "EÏ": c = ChrW$(7864)
                Case "EÂ": c = ChrW$(202)
                Case "EÁ": c = ChrW$(7870)
                Case "EÀ": c = ChrW$(7872)
                Case "EÅ": c = ChrW$(7874)
                Case "EÃ": c = ChrW$(7876)
                Case "EÄ": c = ChrW$(7878)
                Case "OÙ": c = ChrW$(211)
                Case "OØ": c = ChrW$(210)
                Case "OÛ": c = ChrW$(7886)
                Case "OÕ": c = ChrW$(213)
                Case "OÏ": c = ChrW$(7884)
                Case "OÂ": c = ChrW$(212)
                Case "OÁ": c = ChrW$(7888)
                Case "OÀ": c = ChrW$(7890)
                Case "OÅ": c = ChrW$(7892)
                Case "OÃ": c = ChrW$(7894)
                Case "OÄ": c = ChrW$(7896)
                Case "ÔÙ": c = ChrW$(7898)
                Case "ÔØ": c = ChrW$(7900)
                Case "ÔÛ": c = ChrW$(7902)
                Case "ÔÕ": c = ChrW$(7904)
                Case "ÔÏ": c = ChrW$(7906)
                Case "UÙ": c = ChrW$(218)
                Case "UØ": c = ChrW$(217)
                Case "UÛ": c = ChrW$(7910)
                Case "UÕ": c = ChrW$(360)
                Case "UÏ": c = ChrW$(7908)
                Case "ÖÙ": c = ChrW$(7912)
                Case "ÖØ": c = ChrW$(7914)
                Case "ÖÛ": c = ChrW$(7916)
                Case "ÖÕ": c = ChrW$(7918)
                Case "ÖÏ": c = ChrW$(7920)
                Case "YÙ": c = ChrW$(221)
                Case "YØ": c = ChrW$(7922)
                Case "YÛ": c = ChrW$(7926)
                Case "YÕ": c = ChrW$(7928)
                End Select
            Else
                c = Mid(vnstr, i, 1)
                Select Case c
                Case "ô": c = ChrW$(417)
                Case "í": c = ChrW$(237)
                Case "ì": c = ChrW$(236)
                Case "æ": c = ChrW$(7881)
                Case "ó": c = ChrW$(297)
                Case "ò": c = ChrW$(7883)
                Case "ö": c = ChrW$(432)
                Case "î": c = ChrW$(7925)
                Case "ñ": c = ChrW$(273)
                Case "Ô": c = ChrW$(416)
                Case "Í": c = ChrW$(205)
                Case "Ì": c = ChrW$(204)
                Case "Æ": c = ChrW$(7880)
                Case "Ó": c = ChrW$(296)
                Case "Ò": c = ChrW$(7882)
                Case "Ö": c = ChrW$(431)
                Case "Î": c = ChrW$(7924)
                Case "Ñ": c = ChrW$(272)
                End Select
            End If
            VNItoUNICODE = VNItoUNICODE + c
            If db Then i = i + 1
        Next i
    End Function

  8. #8
    Ngày tham gia
    Aug 2015
    Bài viết
    2
    Mã:
    Function UNICODEtoVNI(ByVal vnstr As String)
    Dim c As String, i As Integer
       For i = 1 To Len(vnstr)
          c = Mid(vnstr, i, 1)
          Select Case c
             Case ChrW$(97): c = "a"
             Case ChrW$(225): c = "aù"
             Case ChrW$(224): c = "aø"
             Case ChrW$(7843): c = "aû"
             Case ChrW$(227): c = "aõ"
             Case ChrW$(7841): c = "aï"
             Case ChrW$(259): c = "aê"
             Case ChrW$(7855): c = "aé"
             Case ChrW$(7857): c = "aè"
             Case ChrW$(7859): c = "aú"
             Case ChrW$(7861): c = "aü"
             Case ChrW$(7863): c = "aë"
             Case ChrW$(226): c = "aâ"
             Case ChrW$(7845): c = "aá"
             Case ChrW$(7847): c = "aà"
             Case ChrW$(7849): c = "aå"
             Case ChrW$(7851): c = "aã"
             Case ChrW$(7853): c = "aä"
             Case ChrW$(101): c = "e"
             Case ChrW$(233): c = "eù"
             Case ChrW$(232): c = "eø"
             Case ChrW$(7867): c = "eû"
             Case ChrW$(7869): c = "eõ"
             Case ChrW$(7865): c = "eï"
             Case ChrW$(234): c = "eâ"
             Case ChrW$(7871): c = "eá"
             Case ChrW$(7873): c = "eà"
             Case ChrW$(7875): c = "eå"
             Case ChrW$(7877): c = "eã"
             Case ChrW$(7879): c = "eä"
             Case ChrW$(111): c = "o"
             Case ChrW$(243): c = "où"
             Case ChrW$(242): c = "oø"
             Case ChrW$(7887): c = "oû"
             Case ChrW$(245): c = "oõ"
             Case ChrW$(7885): c = "oï"
             Case ChrW$(244): c = "oâ"
             Case ChrW$(7889): c = "oá"
             Case ChrW$(7891): c = "oà"
             Case ChrW$(7893): c = "oå"
             Case ChrW$(7895): c = "oã"
             Case ChrW$(7897): c = "oä"
             Case ChrW$(417): c = "ô"
             Case ChrW$(7899): c = "ôù"
             Case ChrW$(7901): c = "ôø"
             Case ChrW$(7903): c = "ôû"
             Case ChrW$(7905): c = "ôõ"
             Case ChrW$(7907): c = "ôï"
             Case ChrW$(105): c = "i"
             Case ChrW$(237): c = "í"
             Case ChrW$(236): c = "ì"
             Case ChrW$(7881): c = "æ"
             Case ChrW$(297): c = "ó"
             Case ChrW$(7883): c = "ò"
             Case ChrW$(117): c = "u"
             Case ChrW$(250): c = "uù"
             Case ChrW$(249): c = "uø"
             Case ChrW$(7911): c = "uû"
             Case ChrW$(361): c = "uõ"
             Case ChrW$(7909): c = "uï"
             Case ChrW$(432): c = "ö"
             Case ChrW$(7913): c = "öù"
             Case ChrW$(7915): c = "uø"
             Case ChrW$(7917): c = "öû"
             Case ChrW$(7919): c = "öõ"
             Case ChrW$(7921): c = "öï"
             Case ChrW$(121): c = "y"
             Case ChrW$(253): c = "yù"
             Case ChrW$(7923): c = "yø"
             Case ChrW$(7927): c = "yû"
             Case ChrW$(7929): c = "yõ"
             Case ChrW$(7925): c = "î"
             Case ChrW$(273): c = "ñ"
             Case ChrW$(65): c = "A"
             Case ChrW$(193): c = "AÙ"
             Case ChrW$(192): c = "AØ"
             Case ChrW$(7842): c = "AÛ"
             Case ChrW$(195): c = "AÕ"
             Case ChrW$(7840): c = "AÏ"
             Case ChrW$(258): c = "AÊ"
             Case ChrW$(7854): c = "AÉ"
             Case ChrW$(7856): c = "AÈ"
             Case ChrW$(7858): c = "AÚ"
             Case ChrW$(7860): c = "AÜ"
             Case ChrW$(7862): c = "AË"
             Case ChrW$(194): c = "AÂ"
             Case ChrW$(7844): c = "AÁ"
             Case ChrW$(7846): c = "AÀ"
             Case ChrW$(7848): c = "AÅ"
             Case ChrW$(7850): c = "AÃ"
             Case ChrW$(7852): c = "AÄ"
             Case ChrW$(69): c = "E"
             Case ChrW$(201): c = "EÙ"
             Case ChrW$(200): c = "EØ"
             Case ChrW$(7866): c = "EÛ"
             Case ChrW$(7868): c = "EÕ"
             Case ChrW$(7864): c = "EÏ"
             Case ChrW$(202): c = "EÂ"
             Case ChrW$(7870): c = "EÁ"
             Case ChrW$(7872): c = "EÀ"
             Case ChrW$(7874): c = "EÅ"
             Case ChrW$(7876): c = "EÃ"
             Case ChrW$(7878): c = "EÄ"
             Case ChrW$(79): c = "O"
             Case ChrW$(211): c = "OÙ"
             Case ChrW$(210): c = "OØ"
             Case ChrW$(7886): c = "OÛ"
             Case ChrW$(213): c = "OÕ"
             Case ChrW$(7884): c = "OÏ"
             Case ChrW$(212): c = "OÂ"
             Case ChrW$(7888): c = "OÁ"
             Case ChrW$(7890): c = "OÀ"
             Case ChrW$(7892): c = "OÅ"
             Case ChrW$(7894): c = "OÃ"
             Case ChrW$(7896): c = "OÄ"
             Case ChrW$(416): c = "Ô"
             Case ChrW$(7898): c = "ÔÙ"
             Case ChrW$(7900): c = "ÔØ"
             Case ChrW$(7902): c = "ÔÛ"
             Case ChrW$(7904): c = "ÔÕ"
             Case ChrW$(7906): c = "ÔÏ"
             Case ChrW$(73): c = "I"
             Case ChrW$(205): c = "Í"
             Case ChrW$(204): c = "Ì"
             Case ChrW$(7880): c = "Æ"
             Case ChrW$(296): c = "Ó"
             Case ChrW$(7882): c = "Ò"
             Case ChrW$(85): c = "U"
             Case ChrW$(218): c = "UÙ"
             Case ChrW$(217): c = "UØ"
             Case ChrW$(7910): c = "UÛ"
             Case ChrW$(360): c = "UÕ"
             Case ChrW$(7908): c = "UÏ"
             Case ChrW$(431): c = "Ö"
             Case ChrW$(7912): c = "ÖÙ"
             Case ChrW$(7914): c = "ÖØ"
             Case ChrW$(7916): c = "ÖÛ"
             Case ChrW$(7918): c = "ÖÕ"
             Case ChrW$(7920): c = "ÖÏ"
             Case ChrW$(89): c = "Y"
             Case ChrW$(221): c = "YÙ"
             Case ChrW$(7922): c = "YØ"
             Case ChrW$(7926): c = "YÛ"
             Case ChrW$(7928): c = "YÕ"
             Case ChrW$(7924): c = "Î"
             Case ChrW$(272): c = "Ñ"
          End Select
          UNICODEtoVNI = UNICODEtoVNI + c
       Next i
    End Function
    Function UNC(strTCVN3 As String)
        UNC = TCVN3toUNICODE(strTCVN3)
    End Function
    
    Function VNI(strVNI As String)
        VNI = VNItoUNICODE(strVNI)
    End Function
    Ở đây Tuân dùng 2 hàm Window API nhằm giúp cho việc hiện tiếng việt đó là:
    GetActiveWindow và
    MessageBoxW

    Hàm chính mà chúng ta sẽ sử dụng từ module này là:

    Mã:
    Function MsgBoxUni
    Hai biến chuổi mà chúng ta đưa vào phải là chuổi Unicode

    Mã:
    BStrMsg = StrConv(PromptUni, vbUnicode) 'Chuổi thông báo
    BStrTitle = StrConv(TitleUni, vbUnicode) 'Tiêu đề thông báo
    Hàm có khai báo
    Mã:
    Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly
    VbMsgBoxStyle : đây là một enum giúp dễ nhớ và nhanh trong quá trình nhập liệu.




    Bây giờ chúng ta sẽ viết một hàm trong module khác của chúng ta để thông báo tiếng việt.

    Giả sử tôi dùng Font VNI. Đầu tiên tôi cần chỉnh bộ gõ, giả sử tôi gõ Telex và Font VNI thì tôi chỉnh như sau trong UniKey:



    Tôi tắt chế độ gõ tiếng việt cho tới khi tôi cần gõ tiếng việt



    Bây giờ tôi bật chế độ gõ tiếng việt lên và gõ nội dung vào.



    Sau khi hoàn tất bạn hãy thực hiện thủ tục hiện thông báo của mình bằng cách đặt chuột vào thủ tục trên và nhấn F5, các bạn sẽ thấy thông báo tiếng việt hiện ra như sau:



    Đối với TCVN3 thì cũng tương tự: Chỉnh bộ gõ cho đúng/Tắt kiểu gõ tiếng việt cho tới khi cần/Mở kiểu gõ tiếng việt lại khi cần nhập nội dung vào.

    Nếu các bạn thích dùng macro 4 thì hãy vào đây.

    Ngoài ra các bạn có thể sử dụng hàm sau để chuyển đổi kiểu nhập vào là kiểu VNI thành Unicode.

    Ví dụ:

    Mã:
    sUniCode = GoVni2Uni("Tho6ng ba10")
    Biến sUniCode sẽ chứa chuổi Unicode.
    Vậy MsgboxUni ở trên ta có thể viết như sau:

    Mã:
    MsgboxUni GoVni2Uni("Ba5n d9a4 tha2nh co6ng."), vbOkOnly, GoVni2Uni("Tho6ng ba1o")
    Đây là hàm GoVni2Uni

    Mã:
    Function GoVni2Uni(ChuoiGoVni As String) As String    ' Chuyen chuoi go theo kieu Vni thanh chuoi tieng Viet Unicode
    '---------------------------------------------------------------------------------------
    ' Function : GoVni2Uni
    ' Author    : phantronghiep07
    ' Phone: 0915 080 282
    '---------------------------------------------------------------------------------------
        Dim i      As Integer
        Dim MaAcii, VNI
    
        MaAcii = Array(7845, 7847, 7849, 7851, 7853, 226, 225, 224, 7843, 227, 7841, 7855, 7857, 7859, _
                       7861, 7863, 259, 250, 249, 7911, 361, 7909, 7913, 7915, 7917, 7919, 7921, 432, _
                       7871, 7873, 7875, 7877, 7879, 234, 233, 232, 7867, 7869, 7865, 7889, 7891, 7893, _
                       7895, 7897, 244, 243, 242, 7887, 245, 7885, 7899, 7901, 7903, 7905, 7907, 417, _
                       237, 236, 7881, 297, 7883, 253, 7923, 7927, 7929, 7925, 273, 7844, 7846, 7848, _
                       7850, 7852, 194, 193, 192, 7842, 195, 7840, 7854, 7856, 7858, 7860, 7862, 258, _
                       218, 217, 7910, 360, 7908, 7912, 7914, 7916, 7918, 7920, 431, 7870, 7872, 7874, _
                       7876, 7878, 202, 201, 200, 7866, 7868, 7864, 7888, 7890, 7892, 7894, 7896, 212, _
                       211, 210, 7886, 213, 7884, 7898, 7900, 7902, 7904, 7906, 416, 205, 204, 7880, 296, _
                       7882, 221, 7922, 7926, 7928, 7924, 272)
    
        VNI = Array("a61", "a62", "a63", "a64", "a65", "a6", "a1", "a2", "a3", "a4", "a5", "a81", "a82", _
                    "a83", "a84", "a85", "a8", "u1", "u2", "u3", "u4", "u5", "u71", "u72", "u73", "u74", _
                    "u75", "u7", "e61", "e62", "e63", "e64", "e65", "e6", "e1", "e2", "e3", "e4", "e5", _
                    "o61", "o62", "o63", "o64", "o65", "o6", "o1", "o2", "o3", "o4", "o5", "o71", "o72", _
                    "o73", "o74", "o75", "o7", "i1", "i2", "i3", "i4", "i5", "y1", "y2", "y3", "y4", "y5", _
                    "d9", "A61", "A62", "A63", "A64", "A65", "A6", "A1", "A2", "A3", "A4", "A5", _
                    "A81", "A82", "A83", "A84", "A85", "A8", "U1", "U2", "U3", "U4", "U5", "U71", _
                    "U72", "U73", "U74", "U75", "U7", "E61", "E62", "E63", "E64", "E65", "E6", "E1", _
                    "E2", "E3", "E4", "E5", "O61", "O62", "O63", "O64", "O65", "O6", "O1", "O2", _
                    "O3", "O4", "O5", "O71", "O72", "O73", "O74", "O75", "O7", "I1", "I2", "I3", "I4", _
                    "I5", "Y1", "Y2", "Y3", "Y4", "Y5", "D9")
    
        GoVni2Uni = ChuoiGoVni
        For i = 0 To 133
            GoVni2Uni = Replace(GoVni2Uni, VNI(i), ChrW(MaAcii(i)))
        Next i
    End Function
    Chúc các bạn thành công.

    Lê Văn Duyệt

  9. #9
    quoctiepkt Guest
    Như các bạn đã biết việc hiển thị tiếng Việt trên Title bar của UserForm (Form trong môi trường VBA) cũng không ít lần chúng ta bàn bạc trên diễn đàn. Tôi xin giới thiệu một cách dùng kỹ thuật Hook.

    Nghe đến Hook chắc có bạn không muốn đọc đến rồi ! Nhưng đây là kỹ thuật mà thường chúng ta phải dùng đến khi muốn cải thiện chức năng của các controls cũng như UserForm.

    Khi lập trình trong Visual Basic 6.0, Form trong Visual Basic 6.0 có thuộc tính:

    Mã:
    Me.HWnd
    Để lấy Handle của một form. Trong môi trường lập trình VBA thì không có. Vì vậy chúng ta sẽ dùng hàm sau:
    (Các bạn hãy để ý rằng, một khi các bạn đã lấy được handle của một đối tượng - UserForm chẳng hạn thì các bạn có thể dùng các hàm API liên quan để tác động đến đối tượng một cách triệt để. Ví dụ về việc tạo Menu trong UserForm của Nguyễn Duy Tuân trên diễn đàn)

    Mã:
    Function HWndOfUserForm(UF As MSForms.UserForm) As Long
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' HWndOfUserForm
    ' This returns the window handle (HWnd) of the userform referenced
    ' by UF. It first looks for a top-level window, then a child
    ' of the Application window, then a child of the ActiveWindow.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim AppHWnd As Long
        Dim DeskHWnd As Long
        Dim WinHWnd As Long
        Dim UFHWnd As Long
        Dim Cap As String
        Dim WindowCap As String
    
        Cap = UF.Caption
    
        ' First, look in top level windows
        UFHWnd = FindWindow(C_USERFORM_CLASSNAME, Cap)
        If UFHWnd <> 0 Then
            HWndOfUserForm = UFHWnd
            Exit Function
        End If
        ' Not a top level window. Search for child of application.
        AppHWnd = Application.HWnd
        UFHWnd = FindWindowEx(AppHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
        If UFHWnd <> 0 Then
            HWndOfUserForm = UFHWnd
            Exit Function
        End If
        ' Not a child of the application.
        ' Search for child of ActiveWindow (Excel's ActiveWindow, not
        ' Window's ActiveWindow).
        If Application.ActiveWindow Is Nothing Then
            HWndOfUserForm = 0
            Exit Function
        End If
        WinHWnd = WindowHWnd(Application.ActiveWindow)
        UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
        HWndOfUserForm = UFHWnd
    
    End Function
    Sau đó chúng ta dùng hàm API sau để thể hiện tiếng Việt trên một UserForm trong VBA:


    Mã:
    Private Declare Function DefWindowProcW Lib "user32" (ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Chúng ta chỉnh sửa một tí hàm SetUniText của thuongall cho phù hợp với môi trường VBA


    Mã:
    Public Sub SetUniText(UF As MSForms.UserForm, ByVal sUniText As String)
    '
    ' Mo ta:        Unicode TitleBar, Frame, Button, CheckBox, Option
    ' Yeu cau:      Frame, Button, CheckBox, Option khong ho tro XP style
    ' Nguoi viet:  thuongall
    ' Email:        thuongall@yahoo.com
    ' Website:      www.caulacbovb.com
    '
        Dim UFHWnd As Long
        Dim WinInfo As Long
        Dim r As Long
    
        UFHWnd = HWndOfUserForm(UF)
        If UFHWnd = 0 Then
            Exit Sub
        End If
    
        DefWindowProcW UFHWnd, WM_SETTEXT, &H0&, StrPtr(sUniText)
    End Sub
    Tất cả những hàm trên tôi đã có đưa vào module để các bạn tải về.
    Công việc của các bạn chỉ cần là


    Mã:
    Private Sub UserForm_Initialize()
        SetUniText Me, VNI("Coäng hoøa xaõ hoäi chuû nghóa vieät nam")
    End Sub
    Hàm VNI, tôi đã giải thích ở phần trên.



    Các bạn có thể tải hai module ở tập tin đính kèm.

    Lê Văn Duyệt

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •