Kích hoạt chuyển Tab trên thanh công cụ Ribbon dùng VBA

Liên hệ QC

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
Tham gia
24/2/13
Bài viết
2,382
Được thích
3,538
Giới tính
Nam
Xin chào các bạn hôm nay tôi chia sẻ cho các bạn một đoạn mã đơn giản dưới đây là đoạn mã dùng để kích hoạt chuyển Tab trên thanh công cụ Ribbon.
Với đoạn mã này các bạn có thể kích hoạt một Tab bất kì nhanh chóng, và cũng có thể kích hoạt Tab Ribbon tự tạo.
Tab Ribbon như một Userform thu nhỏ, thay vì bỏ công sức viết Userform cho một số trường hợp đơn giản, thì các bạn hãy tạo một Tab Ribbon. Như vậy sẽ thuận tiện hơn cho một vài mục đích mà các bạn muốn trong Excel.

***Yêu cầu cài đặt:
1. Tham chiếu trong tool vba thư viện OLE Automation.
2. Cài đặt trong Excel Options, cho phép Excel macro 4.0 (Không cần thiết khi Ribbon không bị ẩn).

JavaScript:
Option Compare Text
Option Explicit

Private Sub ActivateRibbonTab_test()
  'Debug.Print ActivateRibbonTab("File")
  Debug.Print ActivateRibbonTab("Formulas")
End Sub
Function ActivateRibbonTab(ByVal TabName As String) As Boolean
  On Error Resume Next
  Const CHILDID_SELF = 0&, NAVDIR_NEXT = 5&, NAVDIR_FIRSTCHILD = 7&, NAVDIR_LASTCHILD = 8&
  Dim o As IAccessible, i&, j&, n&, l&
  Set o = Application.CommandBars("Ribbon")
  If o.Visible = False Then
    Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", True)"
    Application.OnTime Now, "'" & ThisWorkbook.Name & "'!'ActivateRibbonTab """ & TabName & """'"
    DoEvents
    Exit Function
  End If
  GoSub ao: GoSub ao: GoSub ao: GoSub ao: GoSub ao: GoSub a1
  l = o.accChildCount: GoSub a1
  For i = 1 To l
    GoSub a2
    Select Case UCase(o.accName(CHILDID_SELF))
    Case "RIBBON TABS"
      GoSub a1: l = o.accChildCount: GoSub a1
      For j = 1 To l
        GoSub a2
        If UCase(o.accName(CHILDID_SELF)) = UCase(TabName) Then
          o.accDoDefaultAction CHILDID_SELF
          ActivateRibbonTab = Not CBool(Err.Number)
          Exit Function
        End If
      Next j
    Case "FILE TAB"
      Select Case UCase(TabName)
      Case "FILE", "FILE TAB"
        o.accDoDefaultAction CHILDID_SELF
        ActivateRibbonTab = Not CBool(Err.Number)
        Exit Function
      End Select
    End Select
  Next i
Exit Function
ao: n = NAVDIR_LASTCHILD: GoSub a
Return
a1: n = NAVDIR_FIRSTCHILD: GoSub a
Return
a2: n = NAVDIR_NEXT: GoSub a
Return
a:
  Set o = o.accNavigate(n, CHILDID_SELF)
  If TypeName(o) <> "IAccessible" Then Exit Function
Return
End Function

Các bạn có thể tham khảo thêm các bài viết của tôi tại tag #sanbi udf
 
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom