[分享]增强型状态栏

andysky

效果： rb8TGqT2.rar (12.14 KB, 下载次数: 134)

2007-8-20 10:33 上传

点击文件名下载附件
[分享]增强型状态栏

---

代码：

QUOTE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("AutoCalculate").Reset
End Sub
Private Sub Workbook_Open()
    With Application.CommandBars("AutoCalculate").Controls.Add(Type:=msoControlButton, before:=1, Temporary:=True)
    .Caption = "全部计算(&A)"
    .OnAction = "计算"
     .FaceId = 483
     Application.CommandBars("AutoCalculate").Controls(2).BeginGroup = True
     Application.CommandBars("AutoCalculate").Controls(3).BeginGroup = False
     End With
End Sub
Sub 计算()
    Dim msg As String, cell As Range, i As Integer, temp
   Dim str As String, ChineseChar As Long, Alphabetic As Long, Number As Long
  Dim rng As Range, j As Long
    If TypeName(Selection) <> "Range" Then MsgBox "请选择单元格！", 64, "【友情提示】": Exit Sub
    For Each cell In Selection
    If VBA.IsNumeric(cell.Value) And cell <> "" Then i = i + 1
    Next
    If i = 0 Then
    msg = "平均值：0"
    Else
    msg = "平均值：" & WorksheetFunction.Average(Selection)
    End If
    msg = msg & Chr(10) & "计  数：" & WorksheetFunction.Count(Selection)
    msg = msg & Chr(10) & "计数值：" & WorksheetFunction.CountA(Selection)
    msg = msg & Chr(10) & "最大值：" & WorksheetFunction.Max(Selection)
    msg = msg & Chr(10) & "最小值：" & WorksheetFunction.Min(Selection)
    msg = msg & Chr(10) & "和  计：" & WorksheetFunction.Sum(Selection)
    msg = msg & Chr(10) & "单元格：" & Selection.Count
    MsgBox "您的选区：" & Chr(10) & msg, 64, "【友情提示】"
  For Each rng In Selection
    j = j + Len(rng.Value)
    For i = 1 To Len(rng)
      str = Mid(rng.Value, i, 1)
      If str Like "[一-龥]" = True Then
        ChineseChar = ChineseChar + 1
      ElseIf str Like "[a-zA-Z]" = True Then
        Alphabetic = Alphabetic + 1
      ElseIf str Like "[0-9]" = True Then
        Number = Number + 1
      End If
    Next
  Next
  MsgBox "所选单元格区域中共有字数" & j & "个。" & Chr(10) & "汉字：" & ChineseChar & "个" & _
     Chr(10) & "字母：" & Alphabetic & "个" & Chr(10) & "数字：" & Number & "个" & Chr(10) _
     & "特殊字符及空格:" & j - Alphabetic - Number - ChineseChar & "个。", vbInformation, "字符统计"

End Sub

andysky

為了方便繁體版朋友，以後我的程序盡量做兩個版本）

再給一個繁體版的加載宏

---

karAxL60.rar (11 KB, 下载次数: 19)

2007-8-20 11:05 上传

点击文件名下载附件
[分享]增强型状态栏

QUOTE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("AutoCalculate").Reset
End Sub

Private Sub Workbook_Open()
    With Application.CommandBars("AutoCalculate").Controls.Add(Type:=msoControlButton, before:=1, Temporary:=True)
    .Caption = "全部計算(&A)"
    .OnAction = "計算"
     .FaceId = 483
     Application.CommandBars("AutoCalculate").Controls(2).BeginGroup = True
     Application.CommandBars("AutoCalculate").Controls(3).BeginGroup = False
     End With
End Sub

Sub 計算()
    Dim msg As String, cell As Range, i As Integer, temp
   Dim str As String, ChineseChar As Long, Alphabetic As Long, Number As Long
  Dim rng As Range, j As Long
    If TypeName(Selection) <> "Range" Then MsgBox "請選擇單元格", 64, "友情提示": Exit Sub
    For Each cell In Selection
    If VBA.IsNumeric(cell.Value) And cell <> "" Then i = i + 1
    Next
    If i = 0 Then
    msg = "平均值：" & vbTab & "0"
    Else
    msg = "平均值：" & vbTab & WorksheetFunction.Average(Selection)
    End If
    msg = msg & Chr(10) & "項目個數：" & vbTab & WorksheetFunction.Count(Selection)
    msg = msg & Chr(10) & "數字個數：" & vbTab & WorksheetFunction.CountA(Selection)
    msg = msg & Chr(10) & "最大值：" & vbTab & WorksheetFunction.Max(Selection)
    msg = msg & Chr(10) & "最小值：" & vbTab & WorksheetFunction.Min(Selection)
    msg = msg & Chr(10) & "總計數：" & vbTab & WorksheetFunction.Sum(Selection)
    msg = msg & Chr(10) & "單元格：" & vbTab & Selection.Count
    MsgBox "您的選區：" & Chr(10) & msg, 64, "全部計算"
  For Each rng In Selection
    j = j + Len(rng.Value)
    For i = 1 To Len(rng)
      str = Mid(rng.Value, i, 1)
      If str Like "[一-顩]" = True Then
        ChineseChar = ChineseChar + 1
      ElseIf str Like "[a-zA-Z]" = True Then
        Alphabetic = Alphabetic + 1
      ElseIf str Like "[0-9]" = True Then
        Number = Number + 1
      End If
    Next
  Next
  MsgBox "您的選區共有" & j & "個字符。" & Chr(10) & "其中漢字" & ChineseChar & "個" & _
     Chr(10) & "字母" & Alphabetic & "個" & Chr(10) & "數字" & Number & "個" & Chr(10) _
     & "標點及特殊字符" & j - Alphabetic - Number - ChineseChar & "個", vbInformation, "統計"

End Sub

[此贴子已经被作者于2007-8-20 11:42:37编辑过]

zz5151353

非常感謝 andysky 版主提供分享 !!!
[em23][em23][em23][em23][em23][em23]
[em24][em24][em24][em24][em24][em24]
[em27][em27][em27][em27][em27][em27]

晚枫

谢谢！

kinggua

谢谢～～

纤纤素手

感谢版主分享哦,又有新的工具咯

cxffxc

2007下好象不行

gvntw

学习了

原来这个叫CommandBars("AutoCalculate")

heqilin55

代码怎么运行

huanglicheng

版主请问我这个运行怎么提示“参数不可选"