Chuyển đổi tên các nút lệnh của Office doc

Chuyển đổi tên các nút lệnh của Office
15/01/2002
Nếu máy tính của bạn trong gia đình bạn muốn phổ cập cho người già hoặc trẻ
nhỏ, những người chưa thành thạo Tiếng Anh (Như ở vùng miền núi chẳng hạn)
công dụng của từng nút lệnh, bạn có thể mua các chương trình học tập. Tuy nhiên,
bạn vẫn có thể tạo một lệnh gán vào một phím, ví dụ F12, để khi thi hành, tất cả
tên thuyết minh nút (ToolTip) sẽ chuyển đổi từ tiếng Anh sang tiếng Việt và ngược
lại. Điều này cho phép người học tự đối chứng ý nghĩa của từng từ Anh trên từng
nút lệnh. Thậm chí có thể đổi tên nút thành tiếng nước nào cũng được như Pháp,
Tây Ban Nha (!!!)
Bạn hãy lập một bảng có 5 cột rồi cất vào một tệp nào đó. Trong ví dụ này tôi cất
vào một tệp bằng thủ tục CatTenCacNut. Để mềm dẻo, tôi sẽ cất bằng tên tuỳ ý đặt
thông qua hộp thoại. Tuy nhiên, bạn có thể cố định thẳng vào tên một tệp để rút
ngắn quá trình thực hiện của chương trình. Tôi lập trình trong WinWord. Tương
tự, bạn có thể copy phần mã nguồn để có thể thực hiện đối với tất cả các môi
trường khác có hỗ trợ Visual Basic For Application.
Sau khi cất xong, bạn hãy dùng Word mở tệp và đánh vào cột "Muốn đổi thành"
tên nút tiếng Việt theo ý bạn. Tôi xin lưu ý, bạn phải sử dụng font chữ trùng mã
với font hệ thống của bạn hỗ trợ ToolTip. Trong Office thường là TAHOMA.TTF.
Ví dụ: Nếu bạn dùng mã ABC-TCVN thì phải copy đè tệp TAHOMA.TTF của thư
mục cài ABC\FONTS\SYSTEM vào thư mục cài WINDOWS\FONTS. Còn nếu
bạn dùng UNICODE theo môi trường OFFICE2000, hay WIN2000 trở lên thì phải
chọn mã UNICODE để gõ. Tất nhiên nếu thành thạo, bạn có thể đổi trong Registry
hoặc Ctrol Panel\Display\Apearance chọn Tool Tip và font tương ứng.
Sau khi đánh xong cất vào đĩa. Bạn thực hiện thủ tục DOITENNUT và chọn vào
tệp này để máy dùng làm căn cứ thực hiện.
Thực hiện gán vào tổ hợp phím và tuỳ hứng theo ý bạn.
Chúc thành công.
'==========================================================
==============
Option Explicit

Public const tiede1="Xin đánh vào cột tên Việt theo ý bạn. Đây là tệp dùng để
chuyển đổi tên các nút control từ tiếng Anh ra tiếng Việt. Các cột khác xin không
thay đổi."
Public const TinABC = "Trung tâm Tin học ABC. Email: "
Public const hoicat = "Đã ghi xong vào tệp. Bạn có muốn đánh luôn nghĩa tiếng
Việt cho từng nút bây giờ không? Nếu đánh luôn chọn Yes, nếu lúc khác đánh thì
chọn NO."
Public const hoireset = "Bạn có muốn reset lại các thanh công cụ như ban đầu
không? Nếu có chọn YES. Không chọn NO."
Public const ThongBao="Chương trình sẽ thay tên thuyết minh các nút sang tiếng
Việt. Nếu đồng ý, chọn YES. Nếu không, chọn NO."
'==================
Sub CatTenCacNut()
Dim AllControls As Object
Dim AllBars As Object
Dim ctrl As Object, ba As Object
Dim tenba As String, tenc As String, ca As String, soID
Dim tiep
'Tạo tệp văn bản mới
Application.Documents.Add
Selection.TypeText Text:=Tieude1
Selection.TypeParagraph
Selection.TypeText Text:=TinABC
Selection.TypeParagraph
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1,
NumColumns:=5
Selection.TypeText Text:="Tên Bar"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Tên nút"
Selection.MoveRight Unit:=wdCell

Selection.TypeText Text:="Số ID"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Thuyết minh hiện tại"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Muốn đổi thành"
Set AllBars = CommandBars
For Each ba In AllBars
tiep= MsgBox ( hoireset, vbDefaultButton1 + vbYesNo + vbQuestion, tinabc)
IF tiep = vbYES then
Ba.Reset
End IF
Set AllControls = ba.Controls
For Each ctrl In AllControls
'Thêm dòng này để chạy cho nhanh, không cần hiện kịp trên màn hình
Application.ScreenUpdating = False
tenba = ba.Name
tenc = ctrl.Caption
ca = ctrl.TooltipText
SoID=ctrl.ID
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=tenba
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=tenc
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=soID
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=ca
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="Như cũ"
Application.StatusBar = "Ghi tới thanh công cụ/nút: " & tenba & "/" & ca

Next
Next
tiep= MsgBox ( hoicat, vbDefaultButton1 + vbYesNo + vbQuestion, tinabc)
IF tiep = vbNo then
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End IF
End Sub
'=========
Sub DoiTenNut()
Dim ACFileName, Title As String
Dim Style, Response, x As Integer
' Thông báo sẽ thay tên các nút
Style = vbYesNo + vbInformation + vbDefaultButton2 ' Định nghĩa các nút
Title = TinABC
Response = MsgBox(ThongBao, Style, Title)
If Response = vbNo Then
'exit
GoTo bye:
End If
' nhận tệp dữ liệu cần thay
With Dialogs(wdDialogFileOpen)
.Display
ACFileName =.Name
End With
' Mở tệp CSDL, gọi OpenACDoc() đã định nghĩa
If OpenACDoc(ACFileName) = True Then 'lỗi
' Hiện nội dung, gọi hàm thay
x = ThayTen()
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If

bye:
End Sub
'=========
Function ThayTen()
Dim i, NumRows As Integer
Dim oDoc, oTable, thanh As Object
Dim tenba As String
Dim tenctrl As String
Dim tenID As String
Dim tenanh As String
Dim tenViet As String
Err.Clear
On Error Resume Next
' Kiểm tra format
If ActiveDocument.Words(1) = "Xin" Then
Application.ScreenUpdating = False
Set oDoc = ActiveDocument
Set oTable = oDoc.Tables(1)
NumRows = ActiveDocument.Tables(1).Rows.Count
Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst
Selection.MoveRight Unit:=wdCell, Count:=5
For i = 2 To NumRows
tenba = Selection.Text
Selection.MoveRight Unit:=wdCell
'tenctrl = Selection.Text
Selection.MoveRight Unit:=wdCell
tenID = Selection.Text
Selection.MoveRight Unit:=wdCell
'tenanh = Selection.Text
Selection.MoveRight Unit:=wdCell

tenViet = Selection.Text
Selection.MoveRight Unit:=wdCell
If (tenViet="") OR (Trim(TenViet)<>"Như cũ") Then
Set thanh = CommandBars(tenBa).FindControl Id:=tenID
thanh.TooltipText =tenViet
End IF
Next i
Application.ScreenUpdating = True
End IF
End Function
'============
Public Function OpenACDoc(ByVal ACFileOpenName As String) As Boolean
Dim Style As Integer
OpenACDoc = True
Err.Clear
On Error GoTo OpenACDocErrors
Documents.Open FileName:=ACFileOpenName
OpenACDocErrors:
If Err.Number <> 0 Then
OpenACDoc = False
End If
End Function