常用功能加载宏——单元格字符处理

使用Excel如果经常处理英文资料的话，应该会经常碰到需要转换大小写的情况，Excel提供了UPPER、LOWER等转换函数。

使用函数需要在新的单元格进行转换，每次都要输入公式，转换完成再复制回去，有点麻烦。而且如果要实现首字母大小写转换的话，还必须嵌套Left、Mid等函数，更加不方便。

如果经常有这种情况，那么做Ribbon按钮实现大小写转换就非常方便了，实现效果：

首先添加customUI.xml代码，因为字符处理相关功能较多，所以使用下拉菜单来管理：

代码语言：javascript复制

      <menu id="rbmenuString" label="字符处理&#13;" size="large" imageMso="Spelling">
        <button id="rbbtnFirstToUpper" label="首字母大写" onAction="rbbtnFirstToUpper" imageMso="SlideThemesGallery"/>
        <button id="rbbtnToUpper" label="转换大写" onAction="rbbtnToUpper" imageMso="QuickStylesSets"/>
        <button id="rbbtnToLower" label="转换小写" onAction="rbbtnToLower" imageMso="FootnoteInsert"/>
      </menu>

回调函数：

代码语言：javascript复制

Sub rbbtnFirstToUpper(control As IRibbonControl)
    Call MRange.FirstToUpper
End Sub
Sub rbbtnToUpper(control As IRibbonControl)
    Call MRange.ToUpper
End Sub
Sub rbbtnToLower(control As IRibbonControl)
    Call MRange.ToLower
End Sub

函数实现比较简单，主要就是调用VBA的字符转换函数：

代码语言：javascript复制

Sub FirstToUpper()
    Dim rng As Range, selectRng As Range
    Dim tmp As String
    
    '确保选中的是单元格
    If TypeName(Selection) = "Range" Then
        Set selectRng = Selection
        
        For Each rng In selectRng
            tmp = VBA.CStr(rng.Value)
            rng.Value = VBA.UCase$(VBA.Left$(tmp, 1)) & VBA.Mid$(tmp, 2)
        Next rng
    End If
    
    Set rng = Nothing
    Set selectRng = Nothing
End Sub
Sub ToUpper()
    Dim rng As Range, selectRng As Range
    
    '确保选中的是单元格
    If TypeName(Selection) = "Range" Then
        Set selectRng = Selection
        
        For Each rng In selectRng
            rng.Value = VBA.UCase$(VBA.CStr(rng.Value))
        Next rng
    End If
    
    Set rng = Nothing
    Set selectRng = Nothing
End Sub
Sub ToLower()
    Dim rng As Range, selectRng As Range
    
    '确保选中的是单元格
    If TypeName(Selection) = "Range" Then
        Set selectRng = Selection
        
        For Each rng In selectRng
            rng.Value = VBA.LCase$(VBA.CStr(rng.Value))
        Next rng
    End If
    
    Set rng = Nothing
    Set selectRng = Nothing
End Sub

xml vba excel

0 人点赞