Hiển thị thông tin trên thanh Tiêu đề của Excel (2 người xem)

[NH_DK]

Các thầy và AC cho em hỏi: Giả sử em muốn hiển thị thông tin công ty trên thanh tiêu để của Excel?
Giả sử: Ô A1 của Sheet1 có nội dung: Cty A. Giờ em muốn hiện thị tên Cty A này ở thanh tiêu đề (thay chữ Microsoft Excel). Nếu em thay đổi thông tin của ô A1 thành Cty B thì nó cũng tự động cập nhật theo đổi này.
Mong các thầy và AC chỉ dùm em nhé!

 

[Hai Lúa Miền Tây]

Các thầy và AC cho em hỏi: Giả sử em muốn hiển thị thông tin công ty trên thanh tiêu để của Excel?
Giả sử: Ô A1 của Sheet1 có nội dung: Cty A. Giờ em muốn hiện thị tên Cty A này ở thanh tiêu đề (thay chữ Microsoft Excel). Nếu em thay đổi thông tin của ô A1 thành Cty B thì nó cũng tự động cập nhật theo đổi này.
Mong các thầy và AC chỉ dùm em nhé!

Bạn thử dùng code sau:

Private Sub Worksheet_Activate()
Application.Caption = [A1]
End Sub

 

[NH_DK]

Thật đơn giản thế này mà em không nghĩ ra. Anh cứ nghĩ là dùng const để đặt. Nhưng cũng không được.
Một lần nữa cám ơn anh Đởm nhiều nha!

 

[Hai Lúa Miền Tây]

Thật đơn giản thế này mà em không nghĩ ra. Anh cứ nghĩ là dùng const để đặt. Nhưng cũng không được.
Một lần nữa cám ơn anh Đởm nhiều nha!

Bạn muốn thay đổi A1 thì nó thay đổi theo thì bạn đưa nó vào sự kiện Worksheet_Change là được. Như nhớ là trước khi thoát khỏi file Excel đó bạn nhớ set tên trở lại bình thường nhé.

 

[Laphongten]

Bạn muốn thay đổi A1 thì nó thay đổi theo thì bạn đưa nó vào sự kiện Worksheet_Change là được. Như nhớ là trước khi thoát khỏi file Excel đó bạn nhớ set tên trở lại bình thường nhé.

Dùng change thì em hiểu rùi. Nhưng còn "Như nhớ là trước khi thoát khỏi file Excel đó bạn nhớ set tên trở lại bình thường nhé" em không hiểu lắm. Anh chỉ dùm em cụ thể nhé!
Hay ý anh nói là: Dùng Application.ScreenUpdating có phải không ah!?
Em cũng muốn tìm hiểu nó!?

 

[NH_DK]

Bạn muốn thay đổi A1 thì nó thay đổi theo thì bạn đưa nó vào sự kiện Worksheet_Change là được. Như nhớ là trước khi thoát khỏi file Excel đó bạn nhớ set tên trở lại bình thường nhé.

Em không hiểu anh nói: "set tên trở lại bình thường"!?
Có phải thế này không ah:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.Caption = [A1]
    Application.ScreenUpdating = True
End Sub

Anh chỉ dùm em cho chót nhé! Hi........ Em muốn tìm hiểu cái này mà!

 

[Hai Lúa Miền Tây]

Em không hiểu anh nói: "set tên trở lại bình thường"!?
Có phải thế này không ah:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.Caption = [A1]
    Application.ScreenUpdating = True
End Sub

Anh chỉ dùm em cho chót nhé! Hi........ Em muốn tìm hiểu cái này mà!

Không phải thế, khi bạn chỉnh "Microsoft Excel" thành tên nào đó, khi bạn thoát file ra thì cái tên mới vẫn còn trên tiêu đề, bạn phải trả về tên mạc định cho nó trước khi thoát file.

 

[NH_DK]

Không phải thế, khi bạn chỉnh "Microsoft Excel" thành tên nào đó, khi bạn thoát file ra thì cái tên mới vẫn còn trên tiêu đề, bạn phải trả về tên mạc định cho nó trước khi thoát file.

Em không hiểu cách làm đó. Anh làm luôn cụ thể dùm em nhé!?

 

[sealand]

Để thực hiện đúng yêu cầu của Tác giả thì phải dùng 2 sự kiện:
1/Khi mở file:

Private Sub Workbook_Open()
Application.Caption = Sheet1.[A1]
End Sub

2/Đặt sự kiện khi ô A1 của sheet1 thay đổi:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address="$A$1" then Application.Caption = Sheet1.[A1]
End Sub

Xong! Khỏi phải set cái gì hết vì nó chỉ có mỗi tác động cập nhật màn hình thôi

 

[Hai Lúa Miền Tây]

Em không hiểu cách làm đó. Anh làm luôn cụ thể dùm em nhé!?

Bỏ code sau vào ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Caption = "Microsoft Excel"

End Sub

 

[NH_DK]

Để thực hiện đúng yêu cầu của Tác giả thì phải dùng 2 sự kiện:
1/Khi mở file:

Private Sub Workbook_Open()
Application.Caption = Sheet1.[A1]
End Sub

2/Đặt sự kiện khi ô A1 của sheet1 thay đổi:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address="$A$1" then Application.Caption = Sheet1.[A1]
End Sub

Xong! Khỏi phải set cái gì hết vì nó chỉ có mỗi tác động cập nhật màn hình thôi

Thế này đúng ý em rùi anh ah! Nếu như tách riêng mà dùng 1 trong 2 sự kiện: Hoặc dùng Activate hoặc Change thì vẫn chưa ổn lắm!?
Một lần nữa cám ơn anh sealand nhiều nha!

 

[sealand]

Bài 10# của Dom. là không cần thiết, mặc nhiên khi mở File thì tiêu đền của nó là như vậy. Sau khi mở có thay đổi gì thì thay thôi

 

[ndu96081631]

Giả sử cell A1 tôi gõ chữ CHANGSHIN VN, LTD. Vậy nếu dùng code:

Sub Test()
  Application.Caption = Range("A1").Value
End Sub

Thì tôi sẽ nhìn thấy thanh tiêu đề thế này



Tức là làm gì thì trên thanh tiêu đề cũng có tên file nằm bên phải. Nhân đây đố mọi người làm sao bỏ luôn cái tên file này ---> Giống vầy:



Ẹc... Ẹc....

 

[Hai Lúa Miền Tây]

Giả sử cell A1 tôi gõ chữ CHANGSHIN VN, LTD. Vậy nếu dùng code:

Sub Test()
  Application.Caption = Range("A1").Value
End Sub

Thì tôi sẽ nhìn thấy thanh tiêu đề thế này

View attachment 57233

Tức là làm gì thì trên thanh tiêu đề cũng có tên file nằm bên phải. Nhân đây đố mọi người làm sao bỏ luôn cái tên file này ---> Giống vầy:

View attachment 57234

Ẹc... Ẹc....

Em đã tìm được cách sau:

Option Explicit
Private Declare Function FindWindow _
                         Lib "user32" Alias "FindWindowA" _
                             (ByVal lpClassName As String, _
                              ByVal lpWindowName As String) As Long
Private Declare Function SetWindowText _
                         Lib "user32" Alias "SetWindowTextA" _
                             (ByVal hwnd As Long, _
                              ByVal lpString As String) As Long

Sub AlterExcelCaption(strCaption As String)
 SetWindowText FindWindow("XLMAIN", Application.Caption), strCaption
End Sub

Sub test()
 AlterExcelCaption "Just testing"
End Sub

Nguồn: http://www.officekb.com/Uwe/Forum.aspx/excel-prog/123024/Change-Excel-Title-Bar-Caption

 

[ndu96081631]

Em đã tìm được cách sau:

Option Explicit
Private Declare Function FindWindow _
                         Lib "user32" Alias "FindWindowA" _
                             (ByVal lpClassName As String, _
                              ByVal lpWindowName As String) As Long
Private Declare Function SetWindowText _
                         Lib "user32" Alias "SetWindowTextA" _
                             (ByVal hwnd As Long, _
                              ByVal lpString As String) As Long

Sub AlterExcelCaption(strCaption As String)
 SetWindowText FindWindow("XLMAIN", Application.Caption), strCaption
End Sub

Sub test()
 AlterExcelCaption "Just testing"
End Sub

Nguồn: http://www.officekb.com/Uwe/Forum.aspx/excel-prog/123024/Change-Excel-Title-Bar-Caption

Ẹc... Ẹc... Đâu cần nhiều thế!

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Sub Test1()
  SetWindowText Application.hwnd, Range("A1").Value
End Sub

Không cần đến hàm FindWindow và cái Sub phụ kia làm gì cho dài dòng ---> Vì Application.hwnd đã là window handle của Excel rồi

 

[Nguyễn Duy Tuân]

Em đã tìm được cách sau:

Option Explicit
Private Declare Function FindWindow _
                         Lib "user32" Alias "FindWindowA" _
                             (ByVal lpClassName As String, _
                              ByVal lpWindowName As String) As Long
Private Declare Function SetWindowText _
                         Lib "user32" Alias "SetWindowTextA" _
                             (ByVal hwnd As Long, _
                              ByVal lpString As String) As Long

Sub AlterExcelCaption(strCaption As String)
 SetWindowText FindWindow("XLMAIN", Application.Caption), strCaption
End Sub

Sub test()
 AlterExcelCaption "Just testing"
End Sub

Nguồn: http://www.officekb.com/Uwe/Forum.aspx/excel-prog/123024/Change-Excel-Title-Bar-Caption

Mọi người hoàn thiện thêm là nếu muốn hiển thị chữ có dấu - Unicode thì phải làm thế nào nhé.

 

[ndu96081631]

Mọi người hoàn thiện thêm là nếu muốn hiển thị chữ có dấu - Unicode thì phải làm thế nào nhé.

Làm được nhưng hổng có dễ ăn đâu nha!

Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Declare Function SetBkMode Lib "gdi32.dll" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Declare Function SetTextColor Lib "gdi32.dll" (ByVal hDC As Long, ByVal crColor As Long) As Long
Declare Function TextOut Lib "gdi32.dll" Alias "TextOutW" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, lpString As Any, ByVal nCount As Long) As Long
Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Public Type LOGFONT
  lfHeight As Long: lfWidth As Long: lfEscapement As Long:  lfOrientation As Long: lfWeight As Long: lfItalic As Byte: lfUnderline As Byte
  lfStrikeOut As Byte: lfCharSet As Byte: lfOutPrecision As Byte: lfClipPrecision As Byte: lfQuality As Byte: lfPitchAndFamily As Byte: lfFaceName(32) As Byte
End Type

Public Type Unicode
  H As Byte
  l As Byte
End Type

Dim hFont As Long, Old_hFont As Long
Sub SetUnicodeTitlebar()
  Dim hDC As Long, Result As Long, Lf As LOGFONT, NewCaption() As Unicode
  Dim FontFace As String, NewFontFace() As Byte, Seed As Integer
  SetWindowText Application.hwnd, ""
  hDC = GetWindowDC(Application.hwnd)
  Lf.lfWeight = 700:    FontFace = "Tahoma"
  NewFontFace = StrConv(FontFace, vbFromUnicode)
  For Seed = 1 To Len(FontFace)
    Lf.lfFaceName(Seed - 1) = NewFontFace(Seed - 1)
  Next Seed
  hFont = CreateFontIndirect(Lf)
  Old_hFont = SelectObject(hDC, hFont)
  SetTextColor hDC, &HFFFFFF
  SetBkMode hDC, 1
  NewCaption = UniStr2BytesArray(Range("A1").Value)
  TextOut hDC, 24, 6, NewCaption(0), UBound(NewCaption)
  SelectObject hDC, Old_hFont
  DeleteObject (hFont)
  ReleaseDC Application.hwnd, hDC
End Sub

Function UniStr2BytesArray(SrcStr As String) As Unicode()
  Dim SrcStrLength As Long, Seed As Long, TmpUnicode() As Unicode
  SrcStrLength = LenB(SrcStr)
  ReDim TmpUnicode(SrcStrLength / 2)
  Do Until Seed >= SrcStrLength / 2
    TmpUnicode(Seed).H = CByte(AscB(MidB(SrcStr, Seed * 2 + 1, 1)))
    TmpUnicode(Seed).l = CByte(AscB(MidB(SrcStr, Seed * 2 + 2, 1)))
    Seed = Seed + 1
  Loop
  UniStr2BytesArray = TmpUnicode
End Function

Với chuổi được gõ tại cell A1
--------------------------------
Hic.... những ai mới học mà gặp "rừng" code này chắc... đuối luôn

 

[cmc_bluesky]

Làm được nhưng hổng có dễ ăn đâu nha!

....

Với chuổi được gõ tại cell A1
--------------------------------
Hic.... những ai mới học mà gặp "rừng" code này chắc... đuối luôn

Chèn tiếng Việt chắc không cần thiết lắm.

Bác có thể làm chữ Microsoft Excel thay bằng text trong A1 mà chỉ có hiệu lực với 1 file có A1 thôi, khi mở file khác đồng thời thì vẫn trở lại bình thường là Microsoft Excel, khi chuyển qua cửa sổ file có A1 thì có hiệu lực trở lại.Và mỗi khi mở file có A1 thì đồng thời có hiệu lực luôn, không phải vào chạy Macro. Cảm ơn bác

 

[cmc_bluesky]

Có ai có thể làm chữ "Microsoft Excel" trên thanh handle của Excel thay bằng text trong Cell A1 mà chỉ có hiệu lực với 1 file có A1 thôi, khi mở file khác đồng thời thì vẫn trở lại bình thường là Microsoft Excel, khi chuyển qua cửa sổ file có A1 thì có hiệu lực trở lại là text trong A1.Và mỗi khi mở file có A1 thì đồng thời có hiệu lực luôn, không phải vào chạy Macro không? Xin cảm ơn !