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

xyj

发布于 2020-07-28 11:46:15

4310

发布于 2020-07-28 11:46:15

文章被收录于专栏：VBA 学习

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

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

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

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

      <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>

回调函数：

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的字符转换函数：

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

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2020-06-13，如有侵权请联系 cloudcommunity@tencent.com 删除

xml