Tặng các bạn Unicode Menu trong Userform - UMU (SourceCode)

[Nguyễn Duy Tuân]

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" !

 

[viephanag]

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]

Fixed error in Additional Control in VBA

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]

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]

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]

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]

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]

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

 

[thienthanbe]

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

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]

abc

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

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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.