改下工资条代码的边框(以加粗居中来显示）？

走自己的路

我的老帖：http://club.excelhome.net/thread-651833-1-1.html

收集了各位老师的4个生成工资条的代码，谢谢各位老师了。

不知这四个代码能不能修改如下要求？
要求一：生成工资条后边框--外边框--内边框为粗字体--（请看效果图）
要求二：生成工资条后---字体与数字为居中并加粗显示---（请看效果图）

4个代码都要一种效果（要求1.2）

就这两个要求，如果可以的话，麻烦各位老师帮助修改下，多谢了。

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

走自己的路

..........................................

lu_zhao_long

只改了两、三处，见红色部分。楼主只需要将这段代码复制并替换原来的代码就行了：
Option Explicit

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 LastColumn As Integer
Application.ScreenUpdating = False
With Worksheets("工资表")
    LastRow = .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1).End(xlUp).Row
    LastColumn = .Cells(1, .UsedRange.Columns.Count + 1).End(xlToLeft).Column
End With

If SheetExist("工资条") = False Then
    ThisWorkbook.Worksheets().Add after:=Worksheets("工资表")
    ActiveSheet.Name = "工资条"
   
    With Worksheets("工资表")
        .Rows(1).Copy Destination:=Worksheets("工资条").Cells(1, 1)
    End With
   
    With Worksheets("工资条").Range(Cells(1, 1), Cells(2, LastColumn))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .ColumnWidth = 10.63
        .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 = xlMedium
        
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic
        .Borders(xlInsideHorizontal).Weight = xlMedium
        
    End With
Else
    With Worksheets("工资条")
        .Range(.Cells(3, 1), .UsedRange.SpecialCells(xlCellTypeLastCell)).Delete shift:=xlShiftUp
        .Rows(2).ClearContents
    End With
End If

With Worksheets("工资条")
    For TempRow = 2 To LastRow Step 1
        With Worksheets("工资表")
            .Range(.Cells(TempRow, 1), .Cells(TempRow, LastColumn)).Copy
        End With
        
        .Cells(3 * TempRow - 4, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        
        If TempRow < LastRow Then
            .Range(.Cells(1, 1), .Cells(2, LastColumn)).Copy Destination:=.Cells(3 * TempRow - 2, 1)
            .Rows(3 * TempRow - 1).ClearContents
        End If
    Next TempRow
   
    .Cells(1, 1).Select
End With
Application.ScreenUpdating = True
End Sub

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

unsamesky

是所有的字体都要加粗，还是和你的附图一样，有的加粗，有的不加粗？如果是后者，那么有什么规律没？
如果是前者，那么参看附件，已经将4个代码全部进行了修缮！

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