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

[levanduyet]

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:

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

 

[levanduyet]

InputBox Function or Method ?

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 và 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

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ề.

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

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 TypeName và xét chiều dài của chuổi ký tự

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

 

[levanduyet]

CFormChager của Stephen Bullen, stephen@oaltd.co.uk and Tim Clem

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:

'***************************************************************************
'*
'* 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

 

[levanduyet]

CFormChager của Stephen Bullen, stephen@oaltd.co.uk and Tim Clem

'***************************************************************
'* 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

 

[levanduyet]

CFormChager của Stephen Bullen, stephen@oaltd.co.uk and Tim Clem

_ 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:

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

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.

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

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'If we've disabled the [x] close button, [B]prevent the Alt+F4 keyboard shortcut too[/B] 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

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:

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

 

[levanduyet]

Làm thế nào để Msgbox hiển thị tiếng việt (Unicode)

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:

'****************************************
'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

 

[levanduyet]

Làm thế nào để Msgbox hiển thị tiếng việt (Unicode)

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

 

[levanduyet]

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à:

Function MsgBoxUni

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

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

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ụ:

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:

MsgboxUni GoVni2Uni("Ba5n d9a4 tha2nh co6ng."), vbOkOnly, GoVni2Uni("Tho6ng ba1o")

Đây là hàm GoVni2Uni

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

 

[levanduyet]

Làm thế nào để hiển thị tiếng Việt trên title bar của UserForm

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:

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)

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:

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

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à

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