Lập trình cho Status Bar

[cuongdoannhat]

Chào các bạn.
Mình muốn thực hiện tùy chọn cho thanh Status Bar nhưng không biết làm sao nhờ các bạn giúp mình với.
Trong Excel 2010 khi RClick trên Status Bar mình có thể chọn các hàm như Average, Count, Sum, ... trong danh mục để xem nhanh kết quả các cell chọn trên Sheet.
Bây giờ mình muốn viết một đoạn code đưa một hàm người dùng vào danh mục trên để chọn và sử dụng thì phải làm sao.

 

[vu_tuan_manh_linh]

Hiển thị trạng thái trong status Bar thì làm được rồi (Ready), còn đưa hàm người dùng lên thì mình cũng đang muốn làm mà chưa tìm được cách nào! Xin mọi người giúp đỡ!

 

[cuongdoannhat]

Quả thật khó, tìm mãi mà chẳng thể làm được. Mình chỉ có tạm thay thế bằng cách dùng Label của Status Bar để hiển thị thông tin mong muốn. Bạn nào có thể giúp mình không

 

[Hoàng Trọng Nghĩa]

Quả thật khó, tìm mãi mà chẳng thể làm được

Với Excel 2007 về sau thì thanh status bar có nhiều Hàm và hiển thị nhiều hàm trên đó luôn nếu bạn lựa chọn. Với selection chỉ hiển thị nhiêu đó thôi đã đủ cho bạn thấy được kết quả rồi. Bạn định đặt hàm gì thêm nữa???

 

[cuongdoannhat]

Với Excel 2007 về sau thì thanh status bar có nhiều Hàm và hiển thị nhiều hàm trên đó luôn nếu bạn lựa chọn. Với selection chỉ hiển thị nhiêu đó thôi đã đủ cho bạn thấy được kết quả rồi. Bạn định đặt hàm gì thêm nữa???

Chẳng hạn tôi chọn một vùng dữ liệu gồm nhiều cột, trong đó tôi muốn xem kết quả của việc phân tích các cột trong vùng dữ liệu này và cho ra cùng lúc nhiều kết quả dựa trên các cột, hơn nữa thao tác này phải làm nhiều lần trong bảng tính và vùng chọn cũng không cố định. Do đó tôi viết một hàm xuất ra các kết quả và dự tính hiển thị lên thanh trạng thái để xem nhanh kết quả này, nhưng chưa làm được. Giải pháp tạm thời là đưa kết quả hàm tôi đã viết lên vùng label của Status Bar, sử dụng được nhưng chưa hài lòng lắm

 

[sealand]

Theo mình khi chưa chắc thì đừng nên can thiệp vào hệ thống mà chỉ nên tận dụng vùng Display của StatusBar
Bạn tham khảo file ví dụ với code cho sheet1 như sau;

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i, tb
If Target.Sells.Count > 0 Then
For i = 1 To Target.Columns.Count
tb = tb & "(" & Format(Evaluate("=Sum(" & _
Target.Columns(i).Address & ")"), "#,##0") & ") "
Next
Application.StatusBar = "Sum cac cot vung chon: " & tb
End If
End Sub

Vậy là bạn thoải mái quét chọn các vùng trong sheet1 sẽ có tổng từng cột của vùng chọn

 

[Hoàng Trọng Nghĩa]

Theo mình khi chưa chắc thì đừng nên can thiệp vào hệ thống mà chỉ nên tận dụng vùng Display của StatusBar

Em xin phép cải tiến một chút anh nhé, vì khi nó chọn vùng có giá trị = 0 thì set nó lại bình thường nên thêm thủ tục này:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim i, tb
  If WorksheetFunction.Sum(Selection) = 0 Or Target.Cells.Count = 1 Then
    Application.StatusBar = False
  Else
    For i = 1 To Target.Columns.Count
      tb = tb & "(" & Format(Evaluate("=Sum(" & _
      Target.Columns(i).Address & ")"), "#,##0") & ") "
    Next
    Application.StatusBar = "Sum cac cot vung chon: " & tb
  End If
End Sub

 

[Hoàng Trọng Nghĩa]

Để cải tiến hơn, thì bài này như sau:

Mượn bài của Thầy Seland, tôi viết thêm vài đoạn code nữa có tính tổng quan hơn như Vùng lựa chọn = 0 hoặc chỉ 1 ô được lựa chọn thì reset lại Status bar, ngược lại thì Sum theo cột vùng lựa chọn, khi qua sheet khác, set lại status bar, quay lại hiển thị như đã Sum (giống như giá trị status bar của Excel):

1) Thủ tục Sum theo cột:

Sub SumTheoCot()
  On Error Resume Next
  Dim Target As Range, i As Long, tb As String
  Set Target = Selection
  If WorksheetFunction.Sum(Target) = 0 Or Target.Cells.Count = 1 Then
    Application.StatusBar = False
  Else
    For i = 1 To Target.Columns.Count
      tb = tb & "(" & Format(Evaluate("=Sum(" & _
      Target.Columns(i).Address & ")"), "#,##0") & ") "
    Next
    Application.StatusBar = "Sum cac cot vung chon: " & tb
  End If
End Sub

2) Kiểm tra vùng lựa chọn:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Call SumTheoCot
End Sub

3) Reset Status bar khi qua sheet khác:

Private Sub Worksheet_Deactivate()
  Application.StatusBar = False
End Sub

4) Kiểm tra vùng lựa chọn khi sheet được hiện hành:

Private Sub Worksheet_Activate()
  Call SumTheoCot
End Sub

 

[ndu96081631]

Tôi nghĩ đã lập trình Statusbar thì phải can thiệp được vào Popup của Statusbar function
Theo những gì tác giả mô tả thì tôi đoán rằng tác giả có 1 hàm tự tạo và muốn Add hàm này vào trong Popup của Statusbar
Vậy tôi sẽ làm như sau
1> Giả sử tôi có trước 1 hàm tự tạo (hàm UniqueList chẳng hạn)

Function UniqueList(ParamArray sArray())
  Dim Item, TmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      TmpArr = SubArr
      If TypeName(TmpArr) <> "Variant()" Then
        If TmpArr <> "" Then .Add TmpArr, ""
      Else
        For Each Item In TmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    UniqueList = .Keys
  End With
End Function

2> Giờ sẽ tiến hành Add hàm này vào trong StatusBar

Sub Auto_Open()
  Dim Ctl As CommandBarControl
  With Application.CommandBars(55)
    .Reset
    With .Controls.Add(1)
      .Caption = "stFunc"
      .OnAction = "AddStatusBar"
    End With
  End With
End Sub

Sub Auto_Close()
  Application.CommandBars(55).Reset
End Sub

Sub AddStatusBar()
  Dim Arr
  With Application.CommandBars(55).Controls("stFunc")
    .State = Not (.State)
    If .State And Selection.Count > 1 Then
      Arr = UniqueList(Selection)
      Application.StatusBar = "Unique = " & Join(Arr, ", ")
    Else
      Application.StatusBar = False
    End If
  End With
End Sub

Và code cho sự kiện SelectionChange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Arr
  With Application.CommandBars(55).Controls("stFunc")
    If .State And Target.Count > 1 Then
      Arr = UniqueList(Selection)
      Application.StatusBar = "Unique = " & Join(Arr, ", ")
    Else
      Application.StatusBar = False
    End If
  End With
End Sub

Thử file xem thế nào!
Từ code trên, có thể cải tiến để add bất cứ hàm tự tạo nào ta muốn
(Code còn phải cải tiến thêm mới hoàn hảo)

 

[cuongdoannhat]

Cảm ơn bạn ndu96081631. Thật đúng ý mình rồi. Mình down về nghiên cứu. Một lần nữa cảm ơn các bạn đóng góp và giúp đỡ

 

[cuongdoannhat]

Chào bạn ndu96081631. Down về chạy thử trong Excel 2010 thì phát hiện điều này:
Application.CommandBars(55).Name lại là Format Axis chứ không phải của Status Bar.
Khi đổi thành Application.CommandBars("Status Bar") thì xuất hiện lỗi Method 'Add' of object CommandBarControls failed.
Không chạy được, nhờ bạn giúp dùm

 

[ndu96081631]

Chào bạn ndu96081631. Down về chạy thử trong Excel 2010 thì phát hiện điều này:
Application.CommandBars(55).Name lại là Format Axis chứ không phải của Status Bar.
Khi đổi thành Application.CommandBars("Status Bar") thì xuất hiện lỗi Method 'Add' of object CommandBarControls failed.
Không chạy được, nhờ bạn giúp dùm

Chết cha!
Excel 2007 và Excel 2010 tôi thật sự không biết cái thằng StatusBar gọi là cái gì nữa

 

[cuongdoannhat]

Sorry mục này đã gởi lên rồi

 

[ndu96081631]

Chào bạn ndu96081631. Down về chạy thử trong Excel 2010 thì phát hiện điều này:
Application.CommandBars(55).Name lại là Format Axis chứ không phải của Status Bar.
Khi đổi thành Application.CommandBars("Status Bar") thì xuất hiện lỗi Method 'Add' of object CommandBarControls failed.
Không chạy được, nhờ bạn giúp dùm

Hay là vầy đi: Thay vì Add Function vào StatusBar Function, bạn cho nó vào menu Click phải cũng được vậy
Cách làm tương tự
Đàng nào cũng phải click chuột phải, thôi thì click phải vào cell đi