用vba代码进行加边框的问题？

lipton · 发表于 2010-11-22 18:56

红色的地方为修改的地方，其它没改变，只是把范围加大了。

Public Sub CreateSalarySheet()
Dim LastRow As Long, TempRow As Long
Dim i As Long
Dim arr1, arr2
Dim rng As Range

With Worksheets("工资表")
LastRow = .Cells(65536, 2).End(xlUp).Row
arr1 = .Range("a1").Resize(1, 29).Value
arr2 = .Range("a2").Resize(LastRow - 1, 29).Value
End With

If SheetExist("工资条") = False Then
ThisWorkbook.Worksheets().Add.Name = "工资条"
Sheets("工资条").Range("a1").Resize(1, 11).ColumnWidth = 10.63
Else
Sheets("工资条").Range("a1").Resize(2000, 29).Clear
End If

TempRow = 1

For i = 1 To LastRow - 1
With Worksheets("工资条")
      Set rng = .Cells(TempRow, 1).Resize(2, 29)
      With rng
         .Cells(1, 1).Resize(1, 29) = arr1 '工资条目
         .Cells(2, 1).Resize(1, 29) = WorksheetFunction.Index(arr2, i, 0) '工资条内容
         '以下是设置每一个工资条的边框
         .Borders(xlEdgeLeft).LineStyle = xlContinuous
         .Borders(xlEdgeLeft).ColorIndex = xlAutomatic
         .Borders(xlEdgeLeft).Weight = xlMedium '如果是要细线框，把xlMedium改成xlThin

         .Borders(xlEdgeTop).LineStyle = xlContinuous
         .Borders(xlEdgeTop).ColorIndex = xlAutomatic
         .Borders(xlEdgeTop).Weight = xlMedium '如果是要细线框，把xlMedium改成xlThin

         .Borders(xlEdgeBottom).LineStyle = xlContinuous
         .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
         .Borders(xlEdgeBottom).Weight = xlMedium '如果是要细线框，把xlMedium改成xlThin

         .Borders(xlEdgeRight).LineStyle = xlContinuous
         .Borders(xlEdgeRight).ColorIndex = xlAutomatic
         .Borders(xlEdgeRight).Weight = xlMedium '如果是要细线框，把xlMedium改成xlThin

         .Borders(xlInsideVertical).LineStyle = xlContinuous
         .Borders(xlInsideVertical).ColorIndex = xlAutomatic
         .Borders(xlInsideVertical).Weight = xlThin

         .Borders(xlInsideHorizontal).LineStyle = xlContinuous
         .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic
         .Borders(xlInsideHorizontal).Weight = xlThin
      End With
End With
TempRow = TempRow + 3 '下一位员工
Next i

End Sub

lipton · 发表于 2010-11-22 19:17

请测试：代码还是楼上的代码，实际应用要改相应的工作表名。

lu_zhao_long · 发表于 2010-11-22 19:28

请楼主不要更改我在“工资表”所在工作表内做的“创建工资条”按钮！

我的程序是基于“工资表”内你所做的数据。离开这个工作表，这些操作都是不正确的！“工资条”这个工作表是自动生成的，你不能对其进行任何操作！也就是说你不能在这个工作表内再创建任何按钮。

如果你再次点击“创建工资条”按钮的时候，如果已经存在“工资条”这个工作表，则仅复制“工资条”内已经存在的边框格式！所以，我曾经说过，如果你发现“工资条”工作表内的格式不符合你的要求的时候，则需要将“工资条”这个工作表手动删除，然后才能再次点击“创建工资条”按钮！

看来楼主没有仔细看我在 9 楼写的说明！

原帖由 走自己的路 于 2010-11-22 13:12 发表
如果原工资表庞大数据的话。。。。缺边框 ........................

[ 本帖最后由 lu_zhao_long 于 2010-11-22 19:30 编辑 ]

lu_zhao_long · 发表于 2010-11-22 19:32

只要楼主按照我在 9楼的说明去做，你的要求肯定是能够实现的！

原帖由 走自己的路 于 2010-11-22 13:12 发表
如果原工资表庞大数据的话。。。。缺边框 ........................

lu_zhao_long · 发表于 2010-11-22 19:45

楼主看来不知道我在原来的“工资表”这个工作表内的“创建工资条”按钮是编辑有 VBA 代码的！这段代码可以保证创建工资条代码执行过程中不会有屏幕刷新时产生的闪烁现象！

所以，请楼主在没有彻底理解我写的代码之前不要在其他工作表内胡乱创建“ActiveX” 按钮来执行这段代码！要知道任何代码都是基于一定的条件来编写的。不按照最初的约定条件是会产生错误的！

water_shui · 发表于 2010-11-23 13:57

太強了！高手就是多！

不過發現這工資不高啊！

unsamesky · 发表于 2010-11-23 14:32

后来想了一下，把原来的代码稍作修改，代码的速度至少还可以提升10倍。

Public Sub CreateSalarySheet()
Dim LastRow As Long, TempRow As Long
Dim LastColumn As Integer
On Error Resume Next
Dim sh As Worksheet, arr
Set sh = Sheets("工资条")
If Err.Number = 9 Then '可以利用下标越界错误捕获来判断“工资条”这个工作表是否存在
Set sh = Sheets.Add(after:=Worksheets("工资表"))
sh.Name = "工资条"
End If
sh.Cells.Clear '先清除所有内容
With Worksheets("工资表") '先确定区域工资表行列区域
LastRow = .[a65536].End(xlUp).Row
LastColumn = .[iv1].End(xlToLeft).Column
arr = .Range(.[a1], .Cells(LastRow, LastColumn)).Value
End With
Dim i As Long, m As Integer, brr()
ReDim brr(1 To 3 * LastRow - 3, 1 To LastColumn)
sh.Columns(1 & ":" & LastColumn).ColumnWidth = 10.63
With sh '把这个添加边框提出来，先在1到3行添加一个边框模板
.Range(.Cells(1, 1), .Cells(2, LastColumn)).Borders.LineStyle = xlContinuous '设置整体边框的框线类型
.Range(.Cells(1, 1), .Cells(2, LastColumn)).Borders.ColorIndex = xlAutomatic '设置整体边框的颜色
.Range(.Cells(1, 1), .Cells(2, LastColumn)).BorderAround Weight:=xlMedium '设置外围边框的粗细
.Range(.Cells(1, 1), .Cells(3, LastColumn)).Copy .Range(.Cells(4, 1), .Cells(3 * LastRow - 3, LastColumn)) '然后在需要的区域，一次性添加完边框
End With
For i = 2 To LastRow
For m = 1 To LastColumn
brr(i * 3 - 5, m) = arr(1, m)
brr(i * 3 - 4, m) = arr(i, m)
Next m, i
sh.[a1].Resize(LastRow * 3 - 3, LastColumn) = brr '在这里添加数据即可！
End Sub

复制代码

[ 本帖最后由 unsamesky 于 2010-11-23 14:41 编辑 ]

xhclzjj · 发表于 2010-12-15 09:48

我想用VBA实现一个画边框的效果,.
效果描述: 1:就是当我任意选中三行以上的区域,再执行宏,就能实现外框是粗线,内框是细线.
2:第二行的下边框是粗线
不知道大家有明白我的意思没有,肯请老师们能指教.谢谢

lu_zhao_long · 发表于 2010-12-15 19:52

建议楼主使用录制宏的方法进行录制，然后再进行简单的修改就可以达到你的要求了！

原帖由 xhclzjj 于 2010-12-15 09:48 发表
我想用VBA实现一个画边框的效果,.
效果描述: 1:就是当我任意选中三行以上的区域,再执行宏,就能实现外框是粗线,内框是细线.
2:第二行的下边框是粗线
不知道大家有明白我的意思没有,肯请老师们能 ...

roc.jame · 发表于 2012-7-31 16:29

收藏了谢谢

		自动登录	找回密码
密码			免费注册

[求助] 用vba代码进行加边框的问题？