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

Phát triển chương trình Nguyễn Phương Thảo - 525&527 Điện Biên - TX. Yên Bái

Trung tâm Dạy nghề và Phổ cập Tin học Miền núi ABC

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: tinabc@hn.vnn.vn"

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

PcLeHoan 1996 - 2002
Mirror : http://www.pclehoan.com
Mirror : http://www.lehoanpc.net
Mirror : http://www.ktlehoan.com