当前位置：theitroad>vba VBA绘制边框

vba VBA绘制边框

声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow 原文地址: http://stackoverflow.com/questions/42576796/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-12 12:14:30 　来源:igfitidea点击:

VBA to draw borders

excelvbaexcel-vba

提问by Sahal

Below is the code that i use on one of my spreadsheet to do the formatting and it works without any error.

下面是我在其中一个电子表格上使用的代码来进行格式化，它可以正常工作，没有任何错误。

It's bit lengthy because I got this from Macro Recorder and modified a bit.

它有点冗长，因为我是从 Macro Recorder 得到的，并做了一些修改。

The problem I am encountering with this script is that it takes around 5 to 10 seconds to get the job done.

我在使用此脚本时遇到的问题是完成工作需要大约 5 到 10 秒。

Is there anyway to shorten this code and speed up the process?

无论如何要缩短此代码并加快流程？

Sub FORMAT()

 Application.ScreenUpdating = False


Range("B5:EM5000").Select
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    '''''
    Range("B5:D5").Select
    Range(Selection, Selection.End(xlDown)).Select

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
       .TintAndShade = 0
        .Weight = xlHairline
    End With

      '''''
    Range("B5:c5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 3).Select

   With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble
     .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble
       .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
       .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble
       .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
       .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
       .TintAndShade = 0
        .Weight = xlHairline
    End With
   '''''
 Range("B5:c5").Select
    Range(Selection, Selection.End(xlDown)).Resize(, 25).Offset(0, 5).Select
  With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With


      '''''

    Range("B5:c5").Select
    Range(Selection, Selection.End(xlDown)).Resize(, 11).Offset(0, 27).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With


      '''''

      '''''

    Range("B5:l5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 39).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''

      '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 50).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''

      '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 60).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''
      '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 70).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''

       '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 80).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''




       '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 90).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''





       '''''

    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 100).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''


    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 110).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''

     ''''''''''''''


    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 120).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With





     ''''''''''''''

     ''''''''''''''


    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 130).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With

   ''''''''
    ''''''''''''''


    Range("B5:k5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 140).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With

    Range("B5").Select
    Range(Selection, Selection.End(xlDown)).Offset(0, 38).Select


    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble

        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous

        .TintAndShade = 0
        .Weight = xlHairline
    End With



    ''''''''




     ''''''''''''''
      Range("AP5").Select
    Range(Selection, Selection.End(xlDown)).Select

    Selection.Rows.AutoFit


     ''''''''''''''

      Range("e:f").Select
    Range(Selection, Selection.End(xlDown)).Select
     Selection.NumberFormat = "mmm-yy;@"

     Range("g:h").Select
      Range(Selection, Selection.End(xlDown)).Select
       Selection.NumberFormat = "#,##0"





    ''''''

   Range("B5:EM5000").Select

    With Selection.Font
        .Name = "Calibri"
        .SIZE = 8

    End With




     Application.ScreenUpdating = True

End Sub

采纳答案by Ibo

Think about borders as lines: Top, Right, Bottom, Left, Vertical lines (inside the range) and Horizontal lines (inside the range)

将边框视为线条：上、右、下、左、垂直线（范围内）和水平线（范围内）

One line of code will draw all of the lines for the range. You can modify them to get what you want.

一行代码将绘制该范围的所有线条。你可以修改它们以获得你想要的。

To have a clean code and better control on the execution of code, you should learn to write functions, as an example, I wrote a function that gives you the last row in a given column in a given worksheet.

为了拥有干净的代码并更好地控制代码的执行，您应该学习编写函数，例如，我编写了一个函数，该函数为您提供给定工作表中给定列中的最后一行。

Sub DrawBorder()
    Dim lRow As Integer
    Dim cell As Range
    Dim rng As Range
    Dim WS As Worksheet

    Set WS = ActiveSheet 'you can set this to a specific sheet like Set WS=Sheets("Sheet1")

    'Clear all of the borders in the sheet
    WS.Cells.Borders.LineStyle = xlNone

    'Find the last row in column B=2
    lRow = LastRowInColumn(WS, 2)

    Set rng = WS.Range("B5:D" & lRow)

    'Borders of the cells inside the range
    rng.Borders.LineStyle = xlDot

    'Border of the range as a whole with double lines
    rng.Borders(xlEdgeTop).LineStyle = xlDouble
    rng.Borders(xlEdgeBottom).LineStyle = xlDouble
    rng.Borders(xlEdgeLeft).LineStyle = xlDouble
    rng.Borders(xlEdgeRight).LineStyle = xlDouble

'    'You can use these lines to remove the vertical/horizontal lines isnide a range
'    rng.Borders(xlInsideVertical).LineStyle = xlNone
'    rng.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub


Function LastRowInColumn(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
    'Finds the last row in a particular column which has a value in it
    If sh Is Nothing Then
        Set sh = ActiveSheet
    End If
    LastRowInColumn = sh.Cells(sh.Rows.Count, colNumber).End(xlUp).Row
End Function

回答by Zenwood

Sub Gray_Grid_Lines()

' This sets all the grid lines to a light gray

Cells.Select

    With Selection
          .Borders.LineStyle = xlContinuous
          .Borders.ThemeColor = 1
          .Borders.TintAndShade = -0.15
          .Borders.Weight = xlThin
    End With

Range("A1").Select

End Sub

回答by ar k

I use this code to erase the borders in a selected area and redraw a thin border around the same area. Not sure if this will help anyone.

我使用此代码擦除选定区域中的边框并在同一区域周围重新绘制细边框。不确定这是否会帮助任何人。

Sub noborder_border()
'
' noborder_border Macro
'
' Keyboard Shortcut: Ctrl+Shift+B
'
    With Selection
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
   End With

   With Selection
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeRight).Weight = xlThin
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).Weight = xlThin
   End With
 End Sub

相关推荐

在宏中使用 Excel VBA 关闭活动工作簿

在宏中使用 Excel VBA 关闭活动工作簿

在 VBA 中复制数据透视表值

在 VBA 中复制数据透视表值

VBA 截取网页截图，将其另存为文件并将其附加到新电子邮件中

VBA 截取网页截图，将其另存为文件并将其附加到新电子邮件中

从数据透视表 vba 中提取数据

从数据透视表 vba 中提取数据

相关推荐
最近更新
标签