Tặng các bạn Unicode Menu trong Userform - UMU (SourceCode) (1 người xem)

Nguyễn Duy Tuân · 3/12/08

UMU - Unicode Menu In Userform Version 1.2.2
Gửi tặng các bạn mã nguồn về tạo Unicode Menu trong Userform.

UMU - Unicode Menu In Userform là bộ mã nguồn (OpenSource) tạo menu trên userform trong VBA (Excel, Word,,...) với chuẩn unicode. Bộ mã thiết kế một menu ngang chuẩn và mở, người dùng chỉ cần nhập nội dung menu vào sheet "data", khi chạy menu sẽ lấy dữ liệu từ đó để hiển thị. Menu cho phép hiển thị: Radio, Checkbook, Image (ảnh), Label, Label với tiêu đề và mô tả, hiển thị với kiểu chữ, màu sắc phong phú. Khi download về chạy chắc chắn bạn sẽ thực sự nhạc nhiên...

Kỹ thuật lập trình trong bộ code menu trong userform này là ứng dụng hệ thống các hàm Windows API theo hệ unicode. Kỹ thuật lập trình này hay và mạnh nhưng không phải dễ học. Các bạn có thể cứ đưa vào ứng dụng rồi học dần dần.

Rất mong nhận được ý kiến góp ý của các bạn để UMU được hoàn thiện hơn.

Phiên bản mới nhất UniMenuInUserform 1.2.2, ngày 26/10/2015.

Download UniMenuInUserform v1.2.2

[GPECODE=vb]
'MODULE MenuAPIs
Public Declare Function CreateMenu Lib "user32.dll" () As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long

Public Declare Function SetMenuItemBitmaps Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Declare Function SetMenuItemInfo Lib "user32.dll" Alias "SetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal BOOL As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function SetMenuItemInfoStr Lib "user32.dll" Alias "SetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal BOOL As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO_STRINGDATA) As Long
Public Declare Function SetMenuItemInfoDATA Lib "user32.dll" Alias "SetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal BOOL As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO_USERDATA) As Long
Public Declare Function SetMenuContextHelpId Lib "user32.dll" (ByVal hMenu As Long, ByVal dW As Long) As Long
Public Declare Function SetMenuDefaultItem Lib "user32.dll" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long
Public Declare Function InsertMenu Lib "user32.dll" Alias "InsertMenuW" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemW" (ByVal hMenu As Long, ByVal un As Long, ByVal BOOL As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function InsertMenuItemDATA Lib "user32.dll" Alias "InsertMenuItemW" (ByVal hMenu As Long, ByVal un As Long, ByVal BOOL As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO_USERDATA) As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuW" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long

Public Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Declare Function CheckMenuItem Lib "user32.dll" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Public Declare Function CheckMenuRadioItem Lib "user32.dll" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
Public Declare Function EnableMenuItem Lib "user32.dll" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringW" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function GetMenuItemInfoDATA Lib "user32" Alias "GetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO_USERDATA) As Long
Public Declare Function GetMenuItemInfoStr Lib "user32" Alias "GetMenuItemInfoW" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO_STRINGDATA) As Long
Public Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
Public Declare Function GetMenuItemRect Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal uItem As Long, lprcItem As RECT) As Long
Public Declare Function GetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal fByPos As Long, ByVal gmdiFlags As Long) As Long
Public Declare Function GetMenuContextHelpId Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuCheckMarkDimensions Lib "user32" () As Long
Public Declare Function GetSystemMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Public Declare Function ModifyMenu Lib "user32.dll" Alias "ModifyMenuW" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Public Declare Function RemoveMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function MenuItemFromPoint Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal ptScreen As POINTAPI) As Long
Public Declare Function HiliteMenuItem Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal wIDHiliteItem As Long, ByVal wHilite As Long) As Long
'CODE
Function ShortcutMenu(ByVal hSubMenu As Long) As Long 'OnRightClick
On Error GoTo EndFunc
Dim IDM&, UMU_MII As UMU_MenuItemInfo
Dim pt As POINTAPI, rc As RECT
Dim rngMenu As Range

If hSubMenu = 0 Then GoTo EndFunc

GetCursorPos pt
IDM = TrackPopupMenu(hSubMenu, TPM_RETURNCMD, pt.X, pt.Y, 0, GetActiveWindow, rc)
'Debug.Print IDM
If IDM = 0 Then GoTo EndFunc

OnCommand IDM

EndFunc:
ShortcutMenu = IDM
If Err.Number Then Debug.Print Err.Number, Err.Description
End Function

Function OnMeasureItemMenu(ByVal hwnd As Long, MI As MEASUREITEMSTRUCT) As Long

On Error GoTo EndFunc

Dim hdc&
Dim wstr1$, wstr2$, UMU_MII As UMU_MenuItemInfo
Dim Pic As StdPicture, sz As Size

'Get the information of menuitem
If GetMenuItemByID(MI.itemID, UMU_MII) < 0 Then
GoTo EndFunc
End If

'wstr1 = StrConv(UMU_MII.lpName, vbFromUnicode)
'wstr2 = StrConv(UMU_MII.lpDetails, vbFromUnicode)
wstr1 = UMU_MII.lpName
wstr2 = UMU_MII.lpDetails

If UMU_MII.BITMAP <> "" Then
Set Pic = GetPicture(UMU_MII.BITMAP) 'Picture
End If

hdc = GetDC(hwnd)
If (Not Pic Is Nothing) Then
MI.ItemWidth = Pic.Width \ DeltaScrX 'PicWidth
MI.ItemHeight = Pic.Height \ DeltaScrY 'PicHeight

MI.ItemHeight = MI.ItemHeight + 4
Else
If wstr2 <> "" Then 'MultiRow
MI.ItemHeight = PicHeight + 4 'The same pic's width
Else 'single row
MI.ItemHeight = mvarItemHeight
End If
End If

'Reset
If UMU_MII.ImgWidth > 0 Then
MI.ItemWidth = UMU_MII.ImgWidth 'PicWidth
End If
If UMU_MII.ImgHeight > 0 Then
MI.ItemHeight = UMU_MII.ImgHeight + 4 'PicHeight + 4
End If

If MI.ItemWidth < mvarItemHeight Then MI.ItemWidth = mvarItemHeight

If UMU_MII.lpName = "-" Then
If Theme = ThemeSystem Or Theme = ThemeOffice2000 Then
MI.ItemHeight = 11
Else
MI.ItemHeight = 5
End If
Else
If MI.ItemHeight < mvarItemHeight Then MI.ItemHeight = mvarItemHeight
End If
'Convert to unicode string
'wstr1 = StrConv(wstr1, vbUnicode)

GetTextExtentPointStr32 hdc, wstr1, Len(wstr1), sz
'Debug.Print wstr1, Len(wstr1) \ 2, sz.cx, mi.ItemWidth
MI.ItemWidth = MI.ItemWidth + sz.cx \ 2 + GetSystemMetrics(SM_CXMENUCHECK) + IIf(Pic Is Nothing, 24, 0)
ReleaseDC hwnd, hdc
Set Pic = Nothing
Exit Function
EndFunc:

If Err.Number <> 0 Then
Debug.Print "Error in OnMeasureItem Function: ", Err.Number, Err.Description
End If

End Function

Function OnDrawItemMenu(ByVal hwnd As Long, di As DRAWITEMSTRUCT) As Long

On Error GoTo EndFunc

Dim rc As RECT
Dim bSelected As Boolean, bEnabled As Boolean, bChecked As Boolean
Dim uflagDT&, clText&, hBr&, bmpHDC&, oldPic&, hFont&, hPrevFont&
Dim wstr1$, wstr2$, UMU_MII As UMU_MenuItemInfo
Dim Pic As StdPicture, br As LOGBRUSH, sz As Size, iArrMenu&

'Get the information of menuitem
iArrMenu = GetMenuItemByID(di.itemID, UMU_MII)
If iArrMenu < 0 Then
GoTo EndFunc
End If

wstr1 = UMU_MII.lpName
wstr2 = UMU_MII.lpDetails

'Convert to unicode string
'wstr1 = StrConv(wstr1, vbUnicode)
'wstr2 = StrConv(wstr2, vbUnicode)
UMU_MII.ImgWidth = UMU_MII.ImgWidth * DeltaScrX
UMU_MII.ImgHeight = UMU_MII.ImgHeight * DeltaScrY
If UMU_MII.BITMAP <> "" Then
Set Pic = GetPicture(UMU_MII.BITMAP) 'Picture
If Not Pic Is Nothing Then
If UMU_MII.ImgWidth <= 0 Then
UMU_MII.ImgWidth = Pic.Width
End If
If UMU_MII.ImgHeight <= 0 Then
UMU_MII.ImgHeight = Pic.Height
End If
End If
End If

'Set color
If DrawStyle = dsOwnerdraw Then
If UMU_MII.BkColor = 0 Or (mvarResetColors And UMU_MII.BkColor <> mvarBkColor) Then UMU_MII.BkColor = mvarBkColor
If UMU_MII.SelBkColor = 0 Or (mvarResetColors And UMU_MII.SelBkColor <> mvarSelBkColor) Then UMU_MII.SelBkColor = mvarSelBkColor
If UMU_MII.TextColor = 0 Or (mvarResetColors And UMU_MII.TextColor <> mvarTextColor) Then UMU_MII.TextColor = mvarTextColor
If UMU_MII.SelTextColor = 0 Or (mvarResetColors And UMU_MII.SelTextColor <> mvarSelTextColor) Then UMU_MII.SelTextColor = mvarSelTextColor
ElseIf DrawStyle = dsAuto Then
If UMU_MII.oldBkColor = 0 Then UMU_MII.BkColor = mvarBkColor
If UMU_MII.oldSelBkColor = 0 Then UMU_MII.SelBkColor = mvarSelBkColor
If UMU_MII.oldTextColor = 0 Then UMU_MII.TextColor = mvarTextColor
If UMU_MII.oldSelTextColor = 0 Then UMU_MII.SelTextColor = mvarSelTextColor
End If

bEnabled = Not ((di.itemState And ODS_DISABLED) = ODS_DISABLED)
bSelected = (di.itemState And ODS_SELECTED) = ODS_SELECTED
bChecked = (di.itemState And ODS_CHECKED) = ODS_CHECKED

If bSelected Then
br.lbColor = UMU_MII.SelBkColor 'GetSysColor(COLOR_HIGHLIGHT)
clText = UMU_MII.SelTextColor ' GetSysColor(COLOR_HIGHLIGHTTEXT) 'vbYellow '
Else
br.lbColor = UMU_MII.BkColor
If UMU_MII.lpName <> "" And UMU_MII.lpDetails <> "" Then
clText = UMU_MII.TextColor 'vbBlue
Else
clText = UMU_MII.TextColor 'GetSysColor(COLOR_MENUTEXT)
End If
End If

If Not bEnabled Then
clText = GetSysColor(COLOR_GRAYTEXT)
End If

rc = di.rcItem
SetTextColor di.hdc, clText
hBr = CreateBrushIndirect(br)

If bSelected Then
If bEnabled Then
If (Theme = ThemeOffice2000) Then

End If
FillRect di.hdc, rc, hBr
End If
Else
FillRect di.hdc, rc, hBr
End If

rc = di.rcItem
If Not Pic Is Nothing Then
bmpHDC = CreateCompatibleDC(di.hdc)
oldPic = SelectObject(bmpHDC, Pic.Handle)

'Debug.Print Err
'Debug.Print "pic.Handle", pic.Handle
'BitBlt di.hdc, di.rcItem.Left, di.rcItem.Top, pic.Width, pic.Height, bmpHDC, 0, 0, SRCCOPY 'NOTSRCCOPY
If Theme = ThemeOffice2000 Then
End If

StretchBlt di.hdc, di.rcItem.Left + 2, di.rcItem.Top + 2, UMU_MII.ImgWidth, _
UMU_MII.ImgHeight, bmpHDC, 0, 0, Pic.Width, Pic.Height, SRCCOPY

'SelectObject bmpHDC, oldPic
DeleteDC bmpHDC
DeleteObject oldPic
rc.Left = rc.Left + UMU_MII.ImgWidth \ DeltaScrX + 4
End If
DeleteObject hBr
SetBkMode di.hdc, Transparent
If Pic Is Nothing Then
rc.Left = rc.Left + GetSystemMetrics(SM_CXMENUCHECK) + 2
End If

rc.Left = rc.Left + 5
rc.Right = rc.Right - 1
If bChecked Or UMU_MII.GroupID > -1 Or UMU_MII.CtrlType = UMU_CtrlCheckBox Then
rc.Left = rc.Left + 5
End If
If wstr2 <> "" Then
rc.Top = rc.Top + 2
hFont = CreateFont(-MulDiv(8, GetDeviceCaps(di.hdc, LOGPIXELSY), 72), 0, 0, 0, FW_EXTRABOLD, 0, 0, 0, 0, 0, 0, 0, 0, StrPtr("Tahoma"))
hPrevFont = SelectObject(di.hdc, hFont)
If Pic Is Nothing Then
DrawText di.hdc, StrPtr(wstr1), Len(wstr1), rc, DT_LEFT
Else
DrawText di.hdc, StrPtr(wstr1), Len(wstr1), rc, DT_CENTER
End If
GetTextExtentPoint32 di.hdc, wstr1, Len(wstr1), sz
If hPrevFont <> 0 Then
SelectObject di.hdc, hPrevFont
End If
DeleteObject hFont '//DeleteObject SelectObject (di.hdc, hPrevFont)
Else 'Single line
DrawText di.hdc, StrPtr(wstr1), Len(wstr1), rc, DT_LEFT Or DT_SINGLELINE Or DT_VCENTER
End If

If wstr2 <> "" Then
rc.Top = rc.Top + sz.cy + 3
rc.Left = rc.Left + IIf(Pic Is Nothing, 0, 2)
DrawText di.hdc, StrPtr(wstr2), Len(wstr2), rc, DT_LEFT Or DT_WORDBREAK
End If

' Separator:
If UMU_MII.bSeparator Then
rc = di.rcItem
rc.Top = (rc.Bottom - rc.Top - 2) \ 2 + rc.Top
rc.Bottom = rc.Top + 2
If (Theme = ThemeOffice2000) Then
End If
DrawEdge di.hdc, rc, BDR_SUNKENOUTER, BF_TOP Or BF_BOTTOM
End If

If (Theme = ThemeOffice2000) Then
End If

If bChecked Then
rc = di.rcItem
rc.Right = 20
If Pic Is Nothing Then
If Not bEnabled Then
SetTextColor di.hdc, GetSysColor(COLOR_GRAYTEXT)
ElseIf Theme = ThemeOffice2000 Then
End If
hFont = CreateFont(-MulDiv(10, GetDeviceCaps(di.hdc, LOGPIXELSY), 72), 0, 0, 0, FW_SEMIBOLD, 0, 0, 0, SYMBOL_CHARSET, 0, 0, 0, 0, StrPtr("Marlett"))
hPrevFont = SelectObject(di.hdc, hFont)
If UMU_MII.GroupID > -1 Then 'Radio
DrawText di.hdc, StrPtr("h"), Len("h"), rc, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
Else
DrawText di.hdc, StrPtr("a"), Len("a"), rc, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE
End If
DeleteObject SelectObject(di.hdc, hPrevFont)
End If
End If

Set Pic = Nothing
Exit Function
EndFunc:

If Err.Number <> 0 Then
Debug.Print "Error in OnDrawItem Function: ", Err.Number, Err.Description
End If

End Function
[/GPECODE]

Nếu thấy hay xin đừng quên "Thanks" %#^#$

!

sealand · 3/12/08

Mình sẽ cố vận dụng, thêm 1 bước hoàn thiện chức năng của Excel cho người SD đại chúng. (Rất tiếc là Dowmload Manager của mình quá 15 ngày dâng không down được)

tedaynui · 3/12/08

Chào Tuân,
Mình test trên máy của mình thấy chưa ổn lắm.

Thanks
TDN

Nguyễn Duy Tuân · 3/12/08

tedaynui đã viết:
Chào Tuân,
Mình test trên máy của mình thấy chưa ổn lắm.

Thanks
TDN

Như hình của anh thì có phải là lỗi hiện chữ unicode trên caption/title của form không anh ? Theo chế độ ngầm định của Windows XP thì font dùng cho caption của form không phải là font unicode, anh cần phải thay bằng các font unicode: Tahoma, Time New Roman, ... Để thay đổi, anh vào Control Pane->Display->Appearance->Advance...

Mr Okebab · 3/12/08

Nếu để Font mặc định của Bill thì không được à bác??
Có cách nào theo Font mặc định của Bill không??
Hoặc là khi chương trình Active thì Wins theo Font Unicode, còn nếu Deactive thì trả lại cho Bill.

Cảm ơn bác.

Thân!

Nguyễn Duy Tuân · 3/12/08

Mr Okebab đã viết:
Nếu để Font mặc định của Bill thì không được à bác??
Có cách nào theo Font mặc định của Bill không??

Với font mặc định của Bill thì tất cả các chương trình viết chuẩn unicode, nếu caption với chữ có dấu đều không hiện được đúng, ngay cả Firefox, IE, Excel,... Bab cứ để ý sẽ thấy.

Nếu vẫn để font mặc định mà hiện được chữ có dấu trên caption thì có một cách là vẽ cấy một control lên đó, ví dụ tạo một control label, sau đó đặt nó lên caption. Cái này tớ có thể làm được nhưng có lẽ không cần (?).

Mr Okebab đã viết:
Hoặc là khi chương trình Active thì Wins theo Font Unicode, còn nếu Deactive thì trả lại cho Bill.

Cảm ơn bác.

Thân!

Cái này làm được nhưng tiến trình thay đổi sẽ mất vài giây, điều này có thể gây sự khó chịu cho người dùng? Thời gian phải đợi giống như người dùng làm bằng tay để thay đổi. Mà việc này nên xử lý trong một ứng dụng hơn là làm trong form để tất cả các form của chương trình được thừa hưởng.

Mã:

Sub Main()
     
      If Not IsUniCaptionFont() Then
             SetUniCaptionFont("Tahoma")
      End If

      '..............Các lệnh, các form trong quá trình chạy của chương trình

      If CaptionFontChanged() Then
             RestoreCaptionFont()
      End If
     
End Sub

trungnt · 4/12/08

Em cũng đã text thử và đã chuyển qua Font Unicode rồi mà sao Form vẫn hiện lên chưa ổn...... Nhờ a Tuấn xem giúp!

cavoi · 4/12/08

CV download về sử dụng tốt, không có trục trặc gì hết
cám ơn anh TuanVNUNI nhe

levanduyet · 4/12/08

To: Tuân,

Còn việc các cấp độ Menu thì như thế nào? Rồi còn cái Combobox trong Menu nữa !
Đã sử dụng, thấy không có bị lỗi. Cám ơn Tuân nhiều.

Lê Văn Duyệt

Nguyễn Duy Tuân · 4/12/08

trungnt đã viết:
Em cũng đã text thử và đã chuyển qua Font Unicode rồi mà sao Form vẫn hiện lên chưa ổn...... Nhờ a Tuấn xem giúp!

Hiện tại, theo chế độ đặt Theme "Classic" thì font trên caption của form bị lỗi, lỗi này mình sẽ tìm hiểu thêm.

levanduyet đã viết:
To: Tuân,

Còn việc các cấp độ Menu thì như thế nào? Rồi còn cái Combobox trong Menu nữa !
Đã sử dụng, thấy không có bị lỗi. Cám ơn Tuân nhiều.

Lê Văn Duyệt

Các cấp độ của menu có thể trong thời gian ngắn em sẽ gửi tiếp phiên bản mới của UMU. Việc gắn ComboBox trong các item của menu có lẽ hơi khó +-+-+-+

. Em sẽ tranh thủ time làm tiếp cho hoàn thiện.

ThuNghi · 4/12/08

Hôm qua có đụng gì trong phần About, không nhớ là double hay RC mà máy treo luôn. Phải thóat = 3 nút. Chắc là tràn bộ nhớ.

Nguyễn Duy Tuân · 4/12/08

Hướng dẫn chỉnh sửa, thêm menu kiểu "About"

ThuNghi đã viết:
Hôm qua có đụng gì trong phần About, không nhớ là double hay RC mà máy treo luôn. Phải thóat = 3 nút. Chắc là tràn bộ nhớ.

Riêng menu "About..." là em sử dụng chế độ vẽ Custom ( có cờ hiệu MF_OWNERDRAW).

Mã:

Function CreateMenuInUserform(ByVal frm As UserForm) As Long

   ....

    'Menu "About"
    hPopUpMenu = CreatePopupMenu()
    mnErr = AppendMenu(hPopUpMenu, MF_BYCOMMAND Or MF_BITMAP Or MF_OWNERDRAW, 1000, ByVal 0&) [COLOR="SeaGreen"]'Sheet1.PicKhanh.Picture.Handle[/COLOR]
    mnErr = AppendMenu(hPopUpMenu, MF_BYCOMMAND Or MF_BITMAP Or MF_OWNERDRAW, 1001, ByVal 0&) [COLOR="SeaGreen"]'Sheet1.PicTuyet.Picture.Handle[/COLOR]
    mnErr = AppendMenu(hPopUpMenu, MF_BYCOMMAND Or MF_BITMAP Or MF_OWNERDRAW, 1003, ByVal 0&) [COLOR="SeaGreen"]'Sheet1.PicTuan.Picture.Handle[/COLOR]

   'Gắn menu "About..." lên menu bar
    mnErr = AppendMenu(hMenu, MF_BYPOSITION Or MF_POPUP, hPopUpMenu, StrPtr("[B]About...[/B]"))

    ...

End Function

Các con số 1000, 1001, 1002 là ID của menu item (hiểu như mã hàng hóa, mã nhân viên, số chứng minh), mã này là cơ sở để thực hiện việc vẽ và chạy lệnh sau này.

Việc vẽ được thực hiện trong hàm WinProc, trong nhánh code Case WM_DRAWITEM

Mã:

Private Function WinProc(ByVal hwnd As Long, ByVal uMsg As Long, _
                            ByVal wParam As Long, ByVal lParam As Long) As Long
   ...

                'Xác lập đối tượng vẽ theo từng menu item, mỗi đối tượng có 3 thông tin: Ảnh (Image), Tên, Sở thích.

                If di.itemID = 1000 Then [COLOR="SeaGreen"]'Nguyễn Duy Khánh[/COLOR]
                    Set pic = Sheet1.PicKhanh.Picture
                    wstr1 = Range("G17").Value
                    wstr2 = Range("H17").Value
                ElseIf di.itemID = 1001 Then[COLOR="SeaGreen"]'Nguyễn Thị Tuyết[/COLOR]
                    Set pic = Sheet1.PicTuyet.Picture
                    wstr1 = Range("G18").Value
                    wstr2 = Range("H18").Value
                Else '[COLOR="SeaGreen"]'Nguyễn Duy Tuân[/COLOR]
                    Set pic = Sheet1.PicTuan.Picture
                    wstr1 = Range("G19").Value
                    wstr2 = Range("H19").Value
                End If
   ...
End Function

Nếu anh muốn thêm hay sửa kiểu menu "About..." thì hãy chỉ quan tâm tới những hướng dẫn trên của em là được. Lưu ý các lệnh trong hàm WinPro phải được viết tuyêt đối chính xác, chỉ cần một lỗi nhỏ là phải nhấn 3 nút đó! **~**

Vì form, mất quyền điều khiển. Cái này có thể trong phiên bản sau em bổ sung việc bẫy lỗi.

Tạm thời mọi người chưa nên nhúng vào ứng dụng của mình ngay mà nên đọc code để tìm hiểu, trong tuần này tôi sẽ hoàn thiện về cấu trúc dữ liệu cho menu, để sau này chúng ta có thể áp dụng cho các trường hợp tổng quát, khi đó các bạn có thể yên tâm nhúng vào ứng dụng của mình.

sealand · 4/12/08

Đã tải về mở thử thấy hoạt động khá linh hoạt, nhưng lỗi font trên menu.
Xem nội dung thì thực sự giật mình chắc là phải lâu lâu mới thấm được, mong các bạn hợp tác trao đổi, các Mod. chỉ bảo để dần nắm được cơ bản. Đây là kỹ thuật quá cao so với VBA.
Nhưng cái gì cũng có giá của nó, làm chủ được thì tiếp tục đẩy Excel thoát xa phần mềm bảng tính. Mình cho đây thực sự là "Giải pháp Excel"

hai2hai · 4/12/08

TuanVNUNI đã viết:
Hiện tại, theo chế độ đặt Theme "Classic" thì font trên caption của form bị lỗi, lỗi này mình sẽ tìm hiểu thêm.

Khi nào Tuân làm được thì gửi cho anh với nhé.

Mr Okebab · 4/12/08

TuanVNUNI đã viết:
Cái này làm được nhưng tiến trình thay đổi sẽ mất vài giây, điều này có thể gây sự khó chịu cho người dùng? Thời gian phải đợi giống như người dùng làm bằng tay để thay đổi. Mà việc này nên xử lý trong một ứng dụng hơn là làm trong form để tất cả các form của chương trình được thừa hưởng.
[/code]

Đúng đó, mình đang nói đến là một chương trình (tạm gọi ở đây chương trình của bác chỉ có 1 form --=0

)
Mấy giây không quan trọng bằng việc gây khó dễ cho người sử dụng.
Nếu có Code để Set cái đó thì Code như thế nào nhỉ ?? Có thể chia sẻ được không ??

Thực ra làm 1 File .reg để chạy luôn cũng được, mỗi lần SET thì chỉ việc chạy file đó để nó chỉnh trong registry.
Tuy nhiên muốn thực hiện hoàn toàn bằng VBA thì như thế nào ?? (Dĩ nhiên không phải lệnh chạy file .reg đó --=0

)

Thân!

hai2hai · 4/12/08

Mr Okebab đã viết:
Nếu có Code để Set cái đó thì Code như thế nào nhỉ ?? Có thể chia sẻ được không ??

Thực ra làm 1 File .reg để chạy luôn cũng được, mỗi lần SET thì chỉ việc chạy file đó để nó chỉnh trong registry.
Tuy nhiên muốn thực hiện hoàn toàn bằng VBA thì như thế nào ?? (Dĩ nhiên không phải lệnh chạy file .reg đó)

Thân!

Ví dụ về thay đổi font hệ thống (tiếng Việt hẳn hoi nhé :-=

):

http://www.ddth.com/showthread.php?t=27279
http://www.ddth.com/showthread.php?t=16687

levanduyet · 5/12/08

Việc thay đổi font hệ thống, theo ý kiến của cá nhân tôi thì không nên.
Trước đây tôi cũng viết theo dạng:
Bước 1: Trước khi thực hiện ứng dụng của mình thì mình đổi font.
Bước 2: Thực hiện ứng dụng.
Bước 3: Trả lại font cho hệ thống.

Nhưng như vậy, đôi lúc người dùng sử dụng một lúc nhiều ứng dụng thì có thể việc đổi font này sẽ gây khó chịu cho người dùng.

LVD

hai2hai · 5/12/08

levanduyet đã viết:
Việc thay đổi font hệ thống, theo ý kiến của cá nhân tôi thì không nên
....

Nhưng như vậy, đôi lúc người dùng sử dụng một lúc nhiều ứng dụng thì có thể việc đổi font này sẽ gây khó chịu cho người dùng.

LVD

Nên hay ko nên là do chủ ý của từng người về cách viết ứng dụng mà. Em thì ko làm cái việc thay đổi font hệ thống (hay bất cứ cái gì của Windows) bao giờ vì như anh nói, nếu giả sử thay đổi font khi bắt đầu khởi động phần mềm, sau đó mình vào Appearance để đổi lại như cũ trong khi ứng dụng của mình vẫn đang hoạt động thì chả có ý nghĩa gì.

Tóm lại, 1 bước đơn giản: Nếu muốn thì người dùng tự đổi hoặc có chỗ trong phần mềm giúp người dùng làm việc đó chứ ko automatic.

Còn như ở trên là do Bab hỏi việc đó thực hiện trong code như thế nào thì em chỉ tìm hộ code thôi (hỏi súng hỏi dao thì tìm hộ, còn sử dụng thế nào, giết ai thì ...kệ :-=

). Vậy code đó dùng như thế nào thì ... kệ bắb (chắc Bab chả care tới chuyện này làm gì đâu nhỉ)

Nguyễn Duy Tuân · 15/12/08

Phiên bản mới UMU v1.1.0, ngày 15/12/08

UMU - Unicode Menu In Userform
Phiên bản mới 1.1.0
Ngày cập nhật: 15-12-2008

Tính năng mới:

+ Sửa lại cấu trúc bảng dữ liệu cho menu trong sheet "Menu Data".
+ Thêm sheet "Images" để chứa các đối tượng ảnh: Image(trong Control Toolbox), ImageList (trong MSCOMCTL.OCX).
+ Toàn bộ mã nguồn được tinh chỉnh lại, viết trong Class Module, làm việc tốt hơn.
+ Nâng cấp, cho phép tạo menu nhiều cấp (không giới hạn) nhờ vào cấu trúc bảng dữ liệu tổng thể.
+ Thêm, tạo ảnh trong các menu item, các popup menu, kích cỡ ảnh người dùng có thể tùy ý thiết lập.
Lưu ý, ảnh được đưa vào đối tượng Image (trong Control Toolbox) hoặc ImageList (trong MSCOMCTL.OCX).
Nếu ảnh trong ImageList, hãy nhập số Index của ảnh vào cột BITMAP, còn nếu dùng ảnh của Image thì dùng tên của nó (Image.Name).
+ Thêm, xử lý các menu item loại CheckBox, Radio.
+ Thêm, cho phép tùy biến về màu sắc của menu.
+ Thêm, tùy biến để menu cho Windows vẽ hoặc để chương trình tự vẽ thông qua tùy chọn của cột OWNERDRAW
Nếu là FALSE thì Windows tự quản lý việc vẽ (giống như các menu cơ bản của các ứng dụng trong Windows)
Nếu là TRUE thì chương trình quản lý và vẽ toàn bộ menu item, nhờ tùy chọn này mà các menu item sẽ được tô điểm đẹp hơn.
Menu có thể được vẽ đẹp hay không là do các lệnh vẽ trong hàm OnDrawItemMenu.
+ Thêm kiểu vẽ cho menu:
System (default): Để Windows vẽ theo chế độ thường
OwnerDrawL: chương trình vẽ lại toàn bộ
Auto: chương trình tự nhận biết để vẽ,...
+ Thêm, cho phép thêm menu vào menu hệ thống (System Menu).
+ Thêm, cho phép đặt menu bên phải của form.
+ Có thể thay đổi thiết lập cho menu trong chế độ chạy.

Thông tin chi tiết mời các bạn xem tại website: http://www.bluesofts.net

Tác giả rất mong các bạn góp ý thêm để chương trình được hoàn thiện hơn.

Các bạn có thể download phiên bản v1.1.0 tại trang đầu.

anhthuan · 17/12/08

Quá tuyệt vời. Xin cảm ơn tác giả nhiều. Và cũng xin mạn phép tác giả cho em xử dụng miễn phí chương trình này vào ứng dụng của em nhé.

Thanks,

Nguyễn Duy Tuân · 17/12/08

Chấp thuận LICENSE để sử dụng miễn phí mã nguồn UMU!

anhthuan đã viết:
Quá tuyệt vời. Xin cảm ơn tác giả nhiều. Và cũng xin mạn phép tác giả cho em xử dụng miễn phí chương trình này vào ứng dụng của em nhé.

Thanks,

Toàn bộ mã nguồn của menu (UMU) bạn có thể sử dụng miễn phí cho ứng dụng của mình, bạn đọc và thực hiện theo LICENSE trong phần About hay trong file gửi kèm nhé!

Khi sản phẩm của bạn sử dụng mã nguồn UMU, bạn có thể mail cho tôi biết tên sản phẩm của bạn.

msc0506 · 14/1/09

Cảm ơn

Đúng là quá cao so với VBA

Trước tiên cảm ơn tác giả nhiều nhé !
(Nguyễn Duy Tuân)
Mình đã dùng cho ứng dụng cá nhân của mình rất hay text trên máy mình thì Font ổn định đang mắc phải 1 vấn đề với API đó là mình sử dụng cho from Main nên có dùng thêm MaxMin (OK) ,Icon ,TakBa chứ khi chạy ẩn excel rồi chẳng thấy nó đâu cả , Nhưng khi thêm Hiện trên thanh status của Win thì bị lỗi :

"lpPrevWndProc = SetWindowLong(hParentWindow, GWL_WNDPROC, AddressOf WndProc)"

Mình lại mù tit về API vậy Tác giả và các bạn giúp mình nhé
Đây là Code mình thêm vào :

'API functions
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 SetWindowPos Lib "user32" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
() As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long

'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Sub AddIcon()
'Add an icon on the titlebar
Dim hWnd As Long
Dim lngRet As Long
Dim hIcon As Long
hIcon = Sheet1.Image1.Picture.Handle
hWnd = FindWindow(vbNullString, UserForm1.Caption)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)
End Sub

Sub AppTasklist(myForm)
'Add this userform into the Task bar
Dim WStyle As Long
Dim Result As Long
Dim hWnd As Long

hWnd = FindWindow(vbNullString, myForm.Caption)
WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
WStyle = WStyle Or WS_EX_APPWINDOW
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_HIDEWINDOW)
Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
SWP_NOMOVE Or _
SWP_NOSIZE Or _
SWP_NOACTIVATE Or _
SWP_SHOWWINDOW)
End Sub

Cảm ơn nhiều

Nguyễn Duy Tuân · 14/1/09

Tốt nhất bạn hãy ghi một cách rõ ràng về lỗi:
+ Bạn đã thêm vào những thủ tục gì ? (Mục đích của thủ tục đó? Mã nguồn?)
+ Tình huống gây lỗi? Hiện tượng ?

Nếu gửi code, bạn hãy, vào bài mới, bấm vào đổi sang khung lớn, đặt code trong

Mã:

 để dễ nhìn. 

Tốt hơn cả là bạn có thể gửi file có mã nguồn chỉ liên quan đến giao diện thì tôi và mọi người mới có thể tìm giúp bạn nhanh hơn.

msc0506 · 15/1/09

Tốt nhất bạn hãy ghi một cách rõ ràng về lỗi:
+ Bạn đã thêm vào những thủ tục gì ? (Mục đích của thủ tục đó? Mã nguồn?)
+ Tình huống gây lỗi? Hiện tượng ?

Mình thêm Minmax ,Icon và TalList cho form Main có dùng Uni Menu nhưng Không được
Bạn giúp mình nhé vì API là mình mù tịt

Đây là code mình thêm vào :

Mã:

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 SetWindowPos Lib "user32" _
                                      (ByVal hWnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal X As Long, _
                                       ByVal Y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" _
                                    Alias "FindWindowA" _
                                    (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
                                         () As Long
Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" _
                                     (ByVal hWnd As Long) As Long


'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Sub AddMinimiseButton()
'//Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLong(hWnd, GWL_STYLE, _
                       GetWindowLong(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub
Sub AppTasklist(myForm)
'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

Nguyễn Duy Tuân · 15/1/09

Trong thủ tục AppTasklist, bạn hãy chữa lại
hWnd = FindWindow(vbNullString, myForm.Caption)
thành
hWnd = FindWindow("ThunderDFrame", myForm.Caption)

Việc thêm hai thủ tục AddMinimiseButton và AppTasklist phải được gọi trước lệnh SetUnicodeCaption.

msc0506 · 16/1/09

Vẫn bị lỗi bạn ơi

on time error '0'

Mình chỉ cần dùng AppTasklist thôi để khi chạy nhiều ứng dụng thì nó hiện trên statut thôi chứ minmax minh dùng cái này

Mã:

Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_STYLE As Long = (-16)
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Sub MinMax(sCaption As String)
Dim hWndForm As Long
Dim iStyle As Long
If Val(Application.Version) < 9 Then
    hWndForm = FindWindow("ThunderXFrame", sCaption)  'XL97
Else
    hWndForm = FindWindow("ThunderDFrame", sCaption)  'XL2000
End If
iStyle = GetWindowLong(hWndForm, GWL_STYLE)
iStyle = iStyle Or WS_MAXIMIZEBOX
iStyle = iStyle Or WS_MINIMIZEBOX
SetWindowLong hWndForm, GWL_STYLE, iStyle
End Sub

Nhưng mình dùng ở Modul mới bạn có thể tích hợp vào luôn modUMUMenu
Thì tuyệt
chỉ còn thiếu Icon và AppTasklist
làmodUMUMenu hoàn hảo là đủ dùng cho ứng dụng

Cảm ơn bạn nhiều !

Nguyễn Duy Tuân · 16/1/09

modUMUMenu và class UMUMenu chỉ để các lệnh xử lý về menu trong dự án "Unicode menu trong Userform", các lệnh tác động với Userform như thay đổi style, icon, resize,...cần làm một class chuyên biệt riêng.

msc0506 · 20/1/09

Minh cũng đã tìm và thay nhiều code trên mạng nhưng đều bị xung ở lỗi trên mà API minh ko biết nên bạn có thể giúp mình vụ này được không ? nếu không mình đành bó tay thội

Cảm ơn

levanduyet · 23/2/09

Dear Tuân,
Anh Test phiên bản 1.1 trên :
_ Window Vista.
_ Excel 2007.

Bị báo lỗi tại hàng này:

LVD

Nguyễn Duy Tuân · 23/2/09

levanduyet đã viết:
Dear Tuân,
Anh Test phiên bản 1.1 trên :
_ Window Vista.
_ Excel 2007.

Bị báo lỗi tại hàng này:

LVD

EM dùng Windows XP + Office 2007 không có lỗi. Có lẽ anh kiểm tra ActiveX Control "MSCOMCT.OCX" xem thế nào.

levanduyet · 23/2/09

Sau khi anh thực hiện update:

http://giaiphapexcel.com/forum/showthread.php?t=19446&page=2

Thì tất cả các control đều được cập nhật. Vậy em theo cái thread anh giới thiệu kiểm tra lại và cập nhật xem sao.

Tks,

LVD

Nguyễn Duy Tuân · 23/2/09

levanduyet đã viết:
Sau khi anh thực hiện update:

http://giaiphapexcel.com/forum/showthread.php?t=19446&page=2

Thì tất cả các control đều được cập nhật. Vậy em theo cái thread anh giới thiệu kiểm tra lại và cập nhật xem sao.

Tks,

LVD

Đúng là khi cập nhật bộ ActiveX Control từ Micosoft thì bị lỗi, lỗi này do không tương thích về interface.
http://www.microsoft.com/downloads/...35-0403-45c4-9e41-459f0eb89e36&displayLang=en

Nguyễn Duy Tuân · 23/2/09

TuanVNUNI đã viết:
Đúng là khi cập nhật bộ ActiveX Control từ Micosoft thì bị lỗi, lỗi này do không tương thích về interface.
http://www.microsoft.com/downloads/...35-0403-45c4-9e41-459f0eb89e36&displayLang=en

Lỗi trên xảy ra chỉ với Office 2007. Đây là lỗi của ActiveX Controls khi update VB6->VB6 SP6 của Microsoft trong Office.

levanduyet · 23/2/09

TuanVNUNI đã viết:
Lỗi trên xảy ra chỉ với Office 2007. Đây là lỗi của ActiveX Controls khi update VB6->VB6 SP6 của Microsoft trong Office.

Bởi vậy mấy file anh viết chẳng sử dụng được.
Chưa khắc phục được ở những máy không có cài VB6.

LVD

cbtm · 1/12/09

Unicode Menu trong Userfor

Trước tiên cám ơn Anh Tuân cho mượn menu form của anh, Nhờ các bạn hoặc anh tuân giúp đở để form gìống như sauUniMenuInUserform 1.1 tiếng anh và Việt thank you

Nguyễn Duy Tuân · 1/12/09

cbtm đã viết:
Trước tiên cám ơn Anh Tuân cho mượn menu form của anh, Nhờ các bạn hoặc anh tuân giúp đở để form gìống như sauUniMenuInUserform 1.1 tiếng anh và Việt thank you

Vâng, em đang tranh thủ sửa lại code để thay đổi ngôn ngữ của menu. Em sẽ sớm gửi phiên bản mới lên.

Nguyễn Duy Tuân · 2/12/09

UniMenuInUserform (version 1.2 - new)

Xin gửi các thành viên phiên bản mới của UMU version 1.2

v1.2.0: (01-Dec-2009)
+ Thêm thuộc tính đổi ngôn ngữ, cho phép menu chuyển đổi hai ngôn ngữ Việt Nam hay ngôn ngữ khác như là English.
+ Thay đổi cấu trúc bảng dữ liệu cho menu (Menu Data).
+ Đối tượng ảnh ImageList đặt trong Userform

Download UniMenuInUserform v1.2

Nguyễn Duy Tuân · 3/12/09

UniMenuInUserform (version 1.2.1 - new)

Xin gửi các thành viên phiên bản mới của UMU version 1.2.1

v1.2.1: (03-Dec-2009)
+ Sửa lỗi ImageList trong Userform
+ Lỗi đo độ rọng của chuỗi trong các Menuitem

Download UniMenuInUserform v1.2.1

huynhkimtien · 2/2/10

Cái này rất hay. Nhưng nó bị lỗi Anh Tuân à.
Nếu mình để form ở chế độ "showmodal=false" khi kích vào menu sẽ không hiện ra và còn bị treo nữa chứ. Anh xem lại thử nhé.

duckyhut · 14/4/10

Các bác ơi. Có ai biết làm thế nào để lấy tên của Popup mà mình kích hoạt không à?

viephanag · 5/8/10

Nhờ anh Tuân hướng dẫn add control ImageList vàoUserForm, vì trong Toolbox Contronl không có control nầy, sử dụng References hoặc Addition controls không hoạt động mặc dù dã chọn MS window commom control (MSCOMCTL.OCX)
Thank
Email : viephanag@gmail.com

Nguyễn Duy Tuân · 5/8/10

Fixed error in Additional Control in VBA

viephanag đã viết:
Nhờ anh Tuân hướng dẫn add control ImageList vàoUserForm, vì trong Toolbox Contronl không có control nầy, sử dụng References hoặc Addition controls không hoạt động mặc dù dã chọn MS window commom control (MSCOMCTL.OCX)
Thank
Email : viephanag@gmail.com

Download file tôi đính kèm và làm theo hướng dẫn nhé.
Cách nạp các controls vào “Toolbox” khi “Additional Controls…” không thự hiện được trong VBA
Tệp “ControlsForUserform.pag” được dùng để nạp (load) các ActiveX controls từ MSCOMCTL.OCX và BSAC.OCX.
Cách nạp:
+ Mở chế độ lập trình VBA, tạo hay mở một Userform
+ Trong cửa sổ “Toolbox” (nơi chứa các controls để nhúng vào Userform), nhấp chuột phải ở khung tab - nơi có chữ “Controls”, chọn “Import Page…” sau đó bạn chỉ tới tệp “ControlsForUserform.pag” rồi mở.

Theo tôi bạn đừng nên tham gia diễn đàn hỏi nhờ rồi cho địa chỉ email để người khác gửi tới. Ở diễn đàn, bạn hỏi ở đâu hãy tới đó để nhận giải pháp, như thế là quá tốt rồi đúng không?

ithow · 28/11/10

Thầy ơi, sao nó hiện ra thông báo này vậy ạ, mong thầy giải đáp giúp
Object library invalid or contains references to object definitions
Em gửi hình đính kèm luôn ạ

namcoi · 17/12/10

Lỗi "Object library invalid or contains references to object definitions"

Vào đây, xoá cái file exd đi là xong, hok tin cứ thử. (win 7 nhé)

C:\Users\Your User Name\AppData\Roaming\Microsoft\Forms

domocotano · 10/3/11

Bác Tuan oi ! Em thấy cái này hay lắm thế còn Vào menu để mở sheets hoặc form ra như thề nào ? Nếu ta cần mở một sheets hoặc form nào đó trong menu. Bác chỉ dùm

Nguyễn Duy Tuân · 10/3/11

domocotano đã viết:
Bác Tuan oi ! Em thấy cái này hay lắm thế còn Vào menu để mở sheets hoặc form ra như thề nào ? Nếu ta cần mở một sheets hoặc form nào đó trong menu. Bác chỉ dùm

Bạn phải biết về VBA. Tạo macro/sub để mở sheet, form, vào sheet Menu Data gì đó gán tên macro này vào cột macro ứng với dòng menu.

domocotano · 13/3/11

Cám ơn bác nhiều , để em tìm hiểu và hỏi lại sau .

thienthanbe · 22/7/11

Nguyễn Duy Tuân đã viết:
Trao đổi về giải pháp Unicode Menu In Userform tại địa chỉ dưới đây:
http://www.giaiphapexcel.com/forum/...-Unicode-Menu-trong-Userform-UMU-(SourceCode)

Bạn có thể bê nguyên code vào userform là được mà.

Xin lổi bạn Tuân vì đã ghi nhầm tên bạn, thật là sơ sót. Bạn thông cảm vì trình đọ VBA của mình còn thấp, do tự mày mò học mà có nên không được căn bản. Mình bê nguyên code vào nhưng bị lỗi ở đoạn code

Mã:

SendKeys "%{ }X"

bạn có thể giảng cho mình biết đoạn code tren có tác dụng gì không? cám ơn nhiều>

hoanghuynhauto · 15/8/12

abc

phần mềm này có thể dung quan lý khach hàng phải ko ạ?

Nguyễn Duy Tuân đã viết:
UMU - Unicode Menu In Userform Version 1.2.1
Gửi tặng các bạn mã nguồn về tạo Unicode Menu trong Userform.

Rất mong nhận được ý kiến góp ý của các bạn để UMU được hoàn thiện hơn.

Phiên bản mới nhất UniMenuInUserform 1.2.1, ngày 03/12/2009.

Download UniMenuInUserform v1.2.1

Nếu thấy hay xin đừng quên "Thanks" !

Hoàng Trọng Nghĩa · 16/8/12

hoanghuynhauto đã viết:
phần mềm này có thể dung quan lý khach hàng phải ko ạ?

Đây là một UserForm, và nó có những control để thực hiện một Menu trên đó, tôi nghĩ nó chỉ là một tiện ích để phục vụ một chương trình nào đó và nó không thể là một phần mềm quản lý khách hàng.

thaivo · 22/10/12

Cám ơn nhiều, nhưng trình độ tôi còn kém quá, chưa thấy hết cái hay!

trungnt · 22/2/13

Tôi có 1 vấn đề mới phát sinh mà tìm mãi không biết nguyên nhân vì sao: Trước đây tôi chỉ cài bộ Office 2003 và sài hàm chuyển đổi font sang Unicode của Pác Tuân thì ngon lành. Nhưng chả hiểu làm sao từ khi cài thêm bộ Office 2010 song hành cùng bộ Office 2003 thì bị lỗi font.......không biết có phải do cài thêm Office 2010.......nhờ Pác Tuân và các anh chị chỉ giúp.

Nguyễn Duy Tuân · 22/2/13

trungnt đã viết:
Tôi có 1 vấn đề mới phát sinh mà tìm mãi không biết nguyên nhân vì sao: Trước đây tôi chỉ cài bộ Office 2003 và sài hàm chuyển đổi font sang Unicode của Pác Tuân thì ngon lành. Nhưng chả hiểu làm sao từ khi cài thêm bộ Office 2010 song hành cùng bộ Office 2003 thì bị lỗi font.......không biết có phải do cài thêm Office 2010.......nhờ Pác Tuân và các anh chị chỉ giúp.

Lỗi không phải do Office mà có thể do Windows bị thay đổi font unicode để hiển thị trong cửa sổ. Bạn hãy tìm cách thay đổi font mặc định trong Control Panel. Font unicode là Tahoma,...

trungnt · 23/2/13

Cái này e tim ra nguyên nhân sơ bộ rùi nhưng chưa biết khắc phục. Vẫn cái file trên đem qua máy khác chỉ cài mỗi Ofice 2003 thì không lỗi font nhưng mang qua máy khác có cài Office 2010 thì bị lỗi như trên. Tìm cách thay đổi font như Pác Tuân hướng dẫn nhưng vẫn không được.......Pác Tuân có cách nào khác không chỉ giúp e với......

Nguyễn Duy Tuân · 24/2/13

trungnt đã viết:
Cái này e tim ra nguyên nhân sơ bộ rùi nhưng chưa biết khắc phục. Vẫn cái file trên đem qua máy khác chỉ cài mỗi Ofice 2003 thì không lỗi font nhưng mang qua máy khác có cài Office 2010 thì bị lỗi như trên. Tìm cách thay đổi font như Pác Tuân hướng dẫn nhưng vẫn không được.......Pác Tuân có cách nào khác không chỉ giúp e với......

File tôi làm là chuẩn UNICODE, những máy nào bộ font unicode chuẩn chưa bị phá thì đều hiện không phụ thuộc loại Office nào cả.

trungnt · 26/2/13

Cái này chắc e pótay.com....E làm đủ mọi cách theo hướng dẫn Pác Tuân mà vẫn không được kể cả cài dập lại Font Unicode mới.

ndu96081631 · 26/2/13

trungnt đã viết:
Cái này chắc e pótay.com....E làm đủ mọi cách theo hướng dẫn Pác Tuân mà vẫn không được kể cả cài dập lại Font Unicode mới.

Xài cái này không được thì xài cái khác...
Thử cách trong file này xem (tuy không hoàn hảo nhưng cũng tạm xài được)

trungnt · 28/2/13

E mới phát hiện ra cái Office2010 khi cài trên máy mình có bị lỗi nên khi xài hàm của Pác Tuân không được......nhưng khi dùng file của Pác ndu96081631 thì lại dùng được.........

Hoàng Trọng Nghĩa · 28/2/13

trungnt đã viết:
E mới phát hiện ra cái Office2010 khi cài trên máy mình có bị lỗi nên khi xài hàm của Pác Tuân không được......nhưng khi dùng file của Pác ndu96081631 thì lại dùng được.........

Nếu chỉ cần MsgBox bằng tiếng Việt, thì xin tặng bạn 1 file với đầy đủ Tiếng Việt kể cả nút lệnh trên MsgBox cũng là tiếng Việt!

http://www.giaiphapexcel.com/forum/...a-bằng-Unicode-tuyệt-đẹp!&p=416372#post416372

khunglongcodon · 19/3/13

Anh Tuân ơi em hỏi cái,
Em dùng cái chương trình của anh, V1.1. Sao ở nhà em chạy được. mà lên cơ quan nó báo: "Compile error: ..." rồi nó tô khối dòng lệnh trong Sheet Images. em đã đăng ký mscomctl.ocx rồi mà nó vẫn báo. Em mở cái file của anh lên thì nó chạy bình thường. Không biết em đăng ký thiếu gì không vậy anh? Cảm ơn anh nhiều nha Em vẫn giữ nguyên form About, nhưng hình của gia đình anh em không để nhé. Hehe.

Nguyễn Duy Tuân · 19/3/13

khunglongcodon đã viết:
Anh Tuân ơi em hỏi cái,
Em dùng cái chương trình của anh, V1.1. Sao ở nhà em chạy được. mà lên cơ quan nó báo: "Compile error: ..." rồi nó tô khối dòng lệnh trong Sheet Images. em đã đăng ký mscomctl.ocx rồi mà nó vẫn báo. Em mở cái file của anh lên thì nó chạy bình thường. Không biết em đăng ký thiếu gì không vậy anh? Cảm ơn anh nhiều nha Em vẫn giữ nguyên form About, nhưng hình của gia đình anh em không để nhé. Hehe.

Lỗi của bạn là do không tương thích phiên bản của ActiveX Controls "mscomctl.ocx". Bạn vào máy chạy được, trong C:\Windows\System32 copy file "mscomctl.ocx" và đè vào file ở máy bị lỗi.

thanchetvnt · 12/6/13

Em nhờ anh Tuân giúp em với.
Cái phần mềm của anh (UniMenuInUserform 1.2.1) rất hay và nó chạy rất tốt trên office 2010. Thế nhưng khi chạy nó trên office 2013 thì cứ báo lỗi hoài. Em còn rất non về VBA nên không thể sửa. Nhờ anh test thử phần mềm đó trên máy chạy office 2013 rồi sửa lỗi giúp em. Cảm ơn anh.

Nguyễn Duy Tuân · 12/6/13

thanchetvnt đã viết:
Em nhờ anh Tuân giúp em với.
Cái phần mềm của anh (UniMenuInUserform 1.2.1) rất hay và nó chạy rất tốt trên office 2010. Thế nhưng khi chạy nó trên office 2013 thì cứ báo lỗi hoài. Em còn rất non về VBA nên không thể sửa. Nhờ anh test thử phần mềm đó trên máy chạy office 2013 rồi sửa lỗi giúp em. Cảm ơn anh.

Tôi đã chạy trên bản Office 2013 32-bit koon có báo lỗi gì. Bản kiểm tra lại và chụp tông báo lỗi như tế nào? Liệu có phải lối những đoạn code của ứng dụng bạn thêm vào không?

thanchetvnt · 14/6/13

Em chạy trên office 2013 64 bit nó báo lỗi. Em chưa hề them hay bớt bất kỳ một đoạn code nào anh ạ.

Nguyễn Duy Tuân · 14/6/13

thanchetvnt đã viết:
Em chạy trên office 2013 64 bit nó báo lỗi. Em chưa hề them hay bớt bất kỳ một đoạn code nào anh ạ.

Phiên bản cũ sử dụng OCX 32-bit của Microsoft nên nếu cạy trên 64-bit sẽ lỗi. Tạm tời bạn sử dụng bản Office 32-bit sẽ ok.

Hoàng Trọng Nghĩa · 14/6/13

Nguyễn Duy Tuân đã viết:
Phiên bản cũ sử dụng OCX 32-bit của Microsoft nên nếu cạy trên 64-bit sẽ lỗi. Tạm tời bạn sử dụng bản Office 32-bit sẽ ok.

Lỗi này hình như là chọn trên Additional Controls đấy Anh Tuân, thử xem có controls nào mà mình chưa có thì check vào.

Nguyễn Duy Tuân · 14/6/13

Hoàng Trọng Nghĩa đã viết:
Lỗi này hình như là chọn trên Additional Controls đấy Anh Tuân, thử xem có controls nào mà mình chưa có thì check vào.

Chính vì sự khác nau giữa 32 & 64-bit nên không thể Additional Controls đó. Tóm lại thư viện MSCOMCTL.OCX (ImageList, TreeView, Lisview,...) đã đến lúc chúng ta nói câu vĩnh biệt.. Unicode menu in Userform chỉ dùng ImageList để nạp ảnh vào menu, chúng ta có thể không cần menu vẫn chạy được.

Hoàng Trọng Nghĩa · 15/6/13

Nguyễn Duy Tuân đã viết:
Chính vì sự khác nau giữa 32 & 64-bit nên không thể Additional Controls đó. Tóm lại thư viện MSCOMCTL.OCX (ImageList, TreeView, Lisview,...) đã đến lúc chúng ta nói câu vĩnh biệt.. Unicode menu in Userform chỉ dùng ImageList để nạp ảnh vào menu, chúng ta có thể không cần menu vẫn chạy được.

Hình như anh chuẩn bị cho "ra lò" phiên bản mới phải không ạ?

Nguyễn Duy Tuân · 15/6/13

Hoàng Trọng Nghĩa đã viết:
Hình như anh chuẩn bị cho "ra lò" phiên bản mới phải không ạ?

Nghĩa nhắc tới phiên bản mới mình mới giựt mình. Đã gần 5 năm chưa nâng cấp mới gì cả --=--

. Có lẽ cũng phải tính hoàn thiện hơn cái menu này thôi. Chờ một ngày đẹp trời đầy cảm hứng mới làm nó ra hồn được.

linhnguyen_0601 · 14/8/13

Em dùng win 8 thì làm thế nào bác ơi

(

namcoi đã viết:
Lỗi "Object library invalid or contains references to object definitions"

Vào đây, xoá cái file exd đi là xong, hok tin cứ thử. (win 7 nhé)

C:\Users\Your User Name\AppData\Roaming\Microsoft\Forms

linhnguyen_0601 · 14/8/13

Em bị lỗi này "Object library invalid or contains references to object definitions" mà lại dùng win 8 thì sao hả bác? Kíu em với

minhcong.tckt · 16/8/13

Anh Tuân cho em hỏi, tại menu "Quản lý" khi em ấn vào "tạo cơ sở dữ liệu" thì làm thế nào để nó di chuyển đến sheet 3 chẳng hạn ???
mong nhận được sự giúp đỡ

kawaicandy · 21/8/13

Cảm ơn tác giả rất nhiều về menu này tuy nhiên có vài vấn đề cho mình hỏi 1 chút:
- Mình xài Menu này để cho phù hợp với công việc của mình nên mình có thêm vào và lược đi 1 vài chức năng. Tuy nhiên do trình độ VBA còn "bập bẹ" nên mình chỉ lược đi được những function của nó, còn phần khai báo thì chịu không biết ở đâu mà tìm. Vậy nó có ảnh hưởng j đến quá trình sử dụng ko (chậm, lỗi ....)
- Mình không muốn chèm thêm các bitmap vào menu sử dụng thì xử lý thế nào.
Một lần nữa cảm ơn tác giả.

namquoc29 · 12/9/13

Lổi object library invalid khi mở Excell

Các bác ơi giúp em với
Máy em mới cài lại Win7 bản quyền
Office 2007 bản quyền
Nhưng khi mở Excell thì báo lổi "Object library invalid or contains references to object definitions that ..."
Trường hợp này thì xử lý như thế nào giúp em với
Cảm ơn
Mail của em: namquoc29@gmail.com

nplvn · 4/10/14

Cảm ơn anh Tuân đã chia sẻ Unicode Menu trong Userform.

Gởi các Anh/Chị giúp đỡ lý do, nguyên nhân không thể gọi được Macro DoSelectItem, nhưng lại gọi được DoReadBMnew, câu lệnh gần như nhau chỉ khác tên form.
Mó tới mò lui hoài vẫn không biết tại sao.

Cảm ơn

nplvn · 4/10/14

nplvn đã viết:
Cảm ơn anh Tuân đã chia sẻ Unicode Menu trong Userform.

Gởi các Anh/Chị giúp đỡ lý do, nguyên nhân không thể gọi được Macro DoSelectItem, nhưng lại gọi được DoReadBMnew, câu lệnh gần như nhau chỉ khác tên form.
Mó tới mò lui hoài vẫn không biết tại sao.

Cảm ơn

Mình quyên đính kèm file.
Các Anh/Chị giành ít thời gian xem giúp
Cảm ơn

nplvn · 6/10/14

nplvn đã viết:
Mình quyên đính kèm file.
Các Anh/Chị giành ít thời gian xem giúp
Cảm ơn

Mấy anh chị xem giúp với
Cảm ơn

Nguyễn Duy Tuân · 6/10/14

nplvn đã viết:
Mấy anh chị xem giúp với
Cảm ơn

Thủ tục "DoSelectItem" vẫn chạy nhưng userform trong đó lỗi vì TreeView. Bạn kiểm tra nhé.

nplvn · 9/10/14

Nguyễn Duy Tuân đã viết:
Thủ tục "DoSelectItem" vẫn chạy nhưng userform trong đó lỗi vì TreeView. Bạn kiểm tra nhé.

Cảm ơn anh, em đã tìm ra lỗi rồi.

huyenphu · 13/10/14

mình thử áp dụng xem thế nào

hungktvn · 7/11/14

Máy của tôi sử dụng Win8 64 bit nên khi mở bị báo lỗi

Tôi có 1 file kho viết trên nền win XP 32bit, giờ sử dụng win8 64 bit nó không chạy được, anh chị em có giải pháp khắc phục nào hỗ trợ tôi với.
Cám ơn

Nguyễn Duy Tuân · 7/11/14

hungktvn đã viết:
Máy của tôi sử dụng Win8 64 bit nên khi mở bị báo lỗi

Tôi có 1 file kho viết trên nền win XP 32bit, giờ sử dụng win8 64 bit nó không chạy được, anh chị em có giải pháp khắc phục nào hỗ trợ tôi với.
Cám ơn

File cucar bạn không liên quan đến chủ đề này. Bạn khóa mã nguồn nên không thể giúp bạn được. Nhưng tôi đoán trong form của bạn có sử dụng các hàm API.

trangvang192 · 27/12/14

Hay qúa nhỉ!
Bạn Tuân! Excel có thể viết được đầy đủ một phần mềm tính tiền trong quán ăn được không?

quykh · 7/10/15

Bác Tuân giúp em với, em có tải file của Bác về và có thêm vào code UserForm_Terminate:

Mã:

Private Sub UserForm_Terminate()    
   Set MyUMUMenu = Nothing
    [B][COLOR=#ff0000]ThisWorkBook.Save
    ThisWorkBook.Close[/COLOR][/B]
End Sub

Ý định của em là đóng Form thì Lưu và đóng excel, thế nhưng khi code chạy lại treo luôn Excel.Mong Thầy giúp đỡ.

comet_1701 · 7/10/15

quykh đã viết:
Bác Tuân giúp em với, em có tải file của Bác về và có thêm vào code UserForm_Terminate:

Mã:

Private Sub UserForm_Terminate() Set MyUMUMenu = Nothing [B][COLOR=#ff0000]ThisWorkBook.Save ThisWorkBook.Close[/COLOR][/B] End Sub

Ý định của em là đóng Form thì Lưu và đóng excel, thế nhưng khi code chạy lại treo luôn Excel.Mong Thầy giúp đỡ.

Tác giả đợt này bận lắm bạn ah (đang mở nhiều lớp giảng dạy mới) nên ko vào GPE nhiều được, bạn theo chân chữ ký của anh ý, có số di động hoặc chát với tác giả nhé. Bạn sẽ dễ dàng liên lạc hơn hoặc đợi thành viên khác trợ giúp nhé. Chúc bạn thành công.

Hoàng Trọng Nghĩa · 7/10/15

quykh đã viết:
Bác Tuân giúp em với, em có tải file của Bác về và có thêm vào code UserForm_Terminate:

Mã:

Private Sub UserForm_Terminate() Set MyUMUMenu = Nothing [B][COLOR=#ff0000]ThisWorkBook.Save ThisWorkBook.Close[/COLOR][/B] End Sub

Ý định của em là đóng Form thì Lưu và đóng excel, thế nhưng khi code chạy lại treo luôn Excel.Mong Thầy giúp đỡ.

Bạn nên tạo một cái Sub gọi Form rồi code nằm ở trong đó như sau:

Sub MenuFormShow()
TenForm.Show
ThisWorkBook.Close True
End Sub

quykh · 8/10/15

Mong Anh chỉ rỏ dùm. Em có tạo code trong thisWorkBook_Open: frmDemo.show
Em thử code của Anh vẫn treo.

Hoàng Trọng Nghĩa · 8/10/15

quykh đã viết:
Mong Anh chỉ rỏ dùm. Em có tạo code trong thisWorkBook_Open: frmDemo.show
Em thử code của Anh vẫn treo.

File bạn có nặng lắm không?

quykh · 8/10/15

Chính File của Bác Tuân luôn đó ah!!!!

Hoàng Trọng Nghĩa · 8/10/15

quykh đã viết:
Chính File của Bác Tuân luôn đó ah!!!!

Vậy cái này phải hỏi Anh Tuân rồi!

quykh · 8/10/15

chắc Bác Tuân bận việc, chưa rảnh. Mong Bác Tuân giúp đỡ. Cám ơn mọi người

Nguyễn Duy Tuân · 11/10/15

quykh đã viết:
chắc Bác Tuân bận việc, chưa rảnh. Mong Bác Tuân giúp đỡ. Cám ơn mọi người

Bạn làm như sau:

sub ChayCT()

formcuaban.show

thisworkbook.close not thisworkbook.saved

end sub

quykh · 11/10/15

Cám ơn Bác Tuân, Sub đó đặt ở đâu vậy Bác.

quykh · 11/10/15

Ý của em là mở menForm của Bác lên làm việc xong, nhấn "Thoát" thì Close Form->Save WorkBooks->Close WorkBooks. Mà Bác có thể cho hiện nút Max.Min,Close của Form được không ah????

Nguyễn Duy Tuân · 11/10/15

quykh đã viết:
Cám ơn Bác Tuân, Sub đó đặt ở đâu vậy Bác.

Đặt code của mìnhvtrong module. Còn từ đâu gọi thủ tục ChayCT thì tuỳ vào mục đích cụ thể của bạn. Có thể gọi từ Thisworkbook_Open() hoặc từ CommandButton

quykh · 24/10/15

Bác Tuân có thể làm cho Form có nút Min, Max, Close được không ah!!!!! Chờ tin của Bác.

Nguyễn Duy Tuân · 26/10/15

Phiên bản mới Unicode Menu In Userform Version 1.2.2, ngày 26-10-2015

Phiên bản mới UMU - Unicode Menu In Userform Version 1.2.2 ngày 26-10-2015

v1.2.2: (26-Oct-2015)
+ Sửa: tính lại độ rộng menu, phiên bản cũ bị lệch trên một số phiên bản Windows mớ.
+ Thêm: nút phóng to, thu nhỏ, resize form

[GPECODE=vb]
'Set userform style
Option Explicit
Const GWL_STYLE = (-16)
Const GWL_EXSTYLE = (-20)
Const WS_MAXIMIZE = &H1000000
Const WS_MAXIMIZEBOX = &H10000
Const WS_MINIMIZE = &H20000000
Const WS_MINIMIZEBOX = &H20000
Const WS_THICKFRAME = &H40000
Const WS_SIZEBOX = WS_THICKFRAME

lPrevStyle = GetWindowLong(hForm, GWL_STYLE)
SetWindowLong hForm, GWL_STYLE, lPrevStyle Or _
(WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_SIZEBOX)
[/GPECODE]

DOWNLOAD v1.2.2 tại bài đầu tiên của topic này.

quykh · 26/10/15

Sao em dowload ở bài #1 nó vẫn là 1.2.1 vậy Bác Tuân????

Nguyễn Duy Tuân · 26/10/15

quykh đã viết:
Sao em dowload ở bài #1 nó vẫn là 1.2.1 vậy Bác Tuân????

Bạn cứ download bản 1.2.2 là đúng đấy, trên website ghi vậy thôi.

sieunhanhoi · 23/2/16

Khi chạy bị lỗi thế này thì sửa thế nào hả bác

Em đang dùng win 8.1 64 bit

Tặng các bạn Unicode Menu trong Userform - UMU (SourceCode) (1 người xem)

Người dùng đang xem chủ đề này

Nghị Hách

File đính kèm

Thành viên gạo cội

(*_*)

File đính kèm

Nghị Hách

Ngon Ngất Ngây

Nghị Hách

Thành viên hoạt động

File đính kèm

Thành viên mới

Hãy để gió cuốn đi.

Nghị Hách

Hãy cho rồi sẽ nhận!

Nghị Hách

Thành viên gạo cội

VNUNi®

Ngon Ngất Ngây

VNUNi®

Hãy để gió cuốn đi.

VNUNi®

Nghị Hách

Thành viên hoạt động

Nghị Hách

Thành viên chính thức

Nghị Hách

Thành viên chính thức

Nghị Hách

Thành viên chính thức

Nghị Hách

Thành viên chính thức

Hãy để gió cuốn đi.

Nghị Hách

Hãy để gió cuốn đi.

Nghị Hách

Nghị Hách

Hãy để gió cuốn đi.

Thành viên mới

Nghị Hách

Nghị Hách

Nghị Hách

Thành viên chính thức

Thành viên mới

Thành viên mới

Nghị Hách

File đính kèm

Thành viên mới

Thành viên mới

Thành viên mới

Nghị Hách

Thành viên mới

Thành viên mới

Thành viên mới

Chuyên gia GPE

Thành viên mới

Thành viên hoạt động

File đính kèm

Nghị Hách

Thành viên hoạt động

Nghị Hách

Thành viên hoạt động

Huyền thoại GPE

File đính kèm

Thành viên hoạt động

Chuyên gia GPE

Thành viên thường trực

Nghị Hách

Thành viên chính thức

Nghị Hách

Thành viên chính thức

File đính kèm

Nghị Hách

Chuyên gia GPE

Nghị Hách

Chuyên gia GPE

Nghị Hách

(_)