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

走自己的路 · 发表于 2010-11-21 18:18

增加新行（新东西,新数据）向下填充不加边框了

1：问题（附件：增加行边框不加了）....

2：问题与第一个问题相似（附件：有的行不加加框了）

具体看附件麻烦大家看看了。。。。是哪里出错了。

期待大家帮我改下代码能否进行解决下...，谢谢。

[ 本帖最后由走自己的路于 2010-11-21 18:23 编辑 ]

excelflower · 发表于 2010-11-21 18:45

第二个附件：
1、把第一、二行的边框设置完全。
2、代码中有三处的“11”列，要改为“17”列。类似这里.Cells(TempRow, 11)，改为.Cells(TempRow, 17)。

走自己的路 · 发表于 2010-11-21 18:55

麻烦老师帮忙改下，上传两个问题的附件可以吗？谢谢,因为还是有点不理解，有解决完后的附件更比较容易理解些.

难道第1个问题不用改vba代码吗？我看了工资表的原文件并不缺边框阿？

如图

excelflower · 发表于 2010-11-21 18:55

第一个附件：是你的原表中，缺边框。

走自己的路 · 发表于 2010-11-21 19:00

从头新建一个结果还是那样。

边框外边框和内边框都加了

03版本

期待2个问题的解决

[ 本帖最后由走自己的路于 2010-11-21 19:01 编辑 ]

yuyangqh · 发表于 2010-11-21 19:15

现在可以动态增加了边框了

excelflower · 发表于 2010-11-21 19:25

原帖由 走自己的路 于 2010-11-21 19:00 发表
从头新建一个结果还是那样。

边框外边框和内边框都加了

03版本

期待2个问题的解决

我这里好用。

lipton · 发表于 2010-11-21 21:14

换一种方式，避开copy，工资表什么样的格式也不受影响。

Public Function SheetExist(ByVal ShName As String) As Boolean
Dim WSh As Worksheet
SheetExist = False
For Each WSh In ThisWorkbook.Worksheets
If WSh.Name = ShName Then
SheetExist = True
Exit For
End If
Next WSh
End Function
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, 11).Value
arr2 = .Range("a2").Resize(LastRow - 1, 11).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, 11).Clear
End If
TempRow = 1
For i = 1 To LastRow - 1
With Worksheets("工资条")
Set rng = .Cells(TempRow, 1).Resize(2, 11)
With rng
.Cells(1, 1).Resize(1, 11) = arr1 '工资条目
.Cells(2, 1).Resize(1, 11) = WorksheetFunction.Index(arr2, i, 0) '工资条内容
'以下是设置每一个工资条的边框
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = xlAutomatic
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = xlAutomatic
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = xlAutomatic
.Borders(xlEdgeRight).Weight = xlMedium
.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

复制代码

lu_zhao_long · 发表于 2010-11-21 22:01

对不起，今天下午在家忙别的事情去了。现在才有空！

文件我已经改好了。
1。只要你先在“工资表”内编辑好数据，然后直接点击“创建工资条”按钮，它就会自动查找第一行有多少列，再然后自动创建“工资条”这个工作表并自动格式化相应数量的列。
2。如果你重新编辑了“工资表”这个工作表，只要再次点击“创建工资条”按钮，它就会在原有的“工资条”这个工作表的基础上重新排版。一旦你发现不是你想要的格式，只要手动将“工资条”这个工作表删除，然后再次点击“创建工资条”按钮就行了。
祝你好运！但愿这能够给你帮助！

陆召龙

2010年 11月 21日

unsamesky · 发表于 2010-11-21 22:02

建议将设置边框的18句代码改成如下：
.Borders.LineStyle = xlContinuous '设置整体边框的框线类型
.Borders.ColorIndex = xlAutomatic '设置整体边框的颜色
.BorderAround Weight:=xlMedium '设置外围边框的粗细

先用Borders设置全体边框，然后用BorderAround设置外围边框。

测试：

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
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
With sh.Range(Cells(i * 3 - 5, 1), Cells(i * 3 - 4, LastColumn))
      .Borders.LineStyle = xlContinuous '设置整体边框的框线类型
      .Borders.ColorIndex = xlAutomatic '设置整体边框的颜色
      .BorderAround Weight:=xlMedium '设置外围边框的粗细
End With
Next
sh.[a1].Resize(LastRow * 3 - 3, LastColumn) = brr
End Sub

[ 本帖最后由 unsamesky 于 2010-11-21 22:44 编辑 ]

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

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

回复 2楼 excelflower 的帖子

回复 4楼 excelflower 的帖子