时间戳

首页 > 解决方案 > EXCEL VBA 宏，用于将样式放入范围，然后 ucase

excel - EXCEL VBA 宏，用于将样式放入范围，然后 ucase

问题描述

我是新手，很抱歉我的长问题

所以，我有两个宏（一个记录并粘贴在个人宏中），另一个我在谷歌找到

第一个，我的选择将颜色填充为橙色并添加粗体边框

第二个选择，大写所有范围。

但是，当我将这两个宏与另一个子（调用子）一起运行时，文本不会显示，我需要更改单元格然后再次选择并再次运行宏才能正常工作。

Sub text ()
Dim rng As Range
Dim sAddr As String
Set rng = Selection

Selection.Merge    
    ActiveCell.FormulaR1C1 = _
        "=""additional due for "" & TEXT(TODAY(),""MMMM "") & ""end of month"""   
   sAddr = rng.Address

    rng = Evaluate("index(upper(" & sAddr & "),)")

    Selection.NumberFormat = "General"

End Sub

然后是填充子（有点长）

Sub ORANGE()


Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        'CAMBIO 2
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
     Selection.NumberFormat = "General"    

End Sub

我使用这两个宏的方式只是先调用 ORANGE，然后调用 TEXT，因为另一种方式不起作用，当我在 VBA 运行宏选项中尝试它们时，它工作正常。

当我使用功能区中的按钮时，我需要更改单元格，再次选择它，它将起作用。我经常使用这个宏，但它只是让我每次都重复它。

有谁知道谁同时执行这两项任务而结果是一个空的橙色单元格？

谢谢！

标签： excel

解决方案

试试这个。阅读代码中的注释：

Public Sub AddTextAndFormat()

    Dim selectedRange As Range

    Set selectedRange = Selection

    ' Merges the selection
    selectedRange.Merge
    ' Adds the formula to the first selection's cell
    selectedRange.Formula = "=""additional due for "" & TEXT(TODAY(),""MMMM "") & ""end of month"""
    ' Uppercase that first cell
    selectedRange.Cells(1, 1).Value = UCase$(selectedRange.Cells(1, 1).Value)

    ' Apply formats
    With selectedRange
        .Font.Bold = True

        ' Borders:
        .BorderAround LineStyle:=xlContinuous, ColorIndex:=0, Weight:=xlMedium

        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone

        ' Other format:
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        'CAMBIO 2
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        '.MergeCells = False  -> This line unmerges the first cells merge
        .NumberFormat = "General"
    End With

    With selectedRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

End Sub

推荐阅读