分享个人审批表-宏批量生成的方法

七彩屋

学习一下

zjdh

hhxq001 发表于 2014-8-15 23:00
是滴呢，看看5楼的怎么解决。

只要插入：
    If Sheets.Count < 5 Then
        MsgBox "你还没有生成报表！"
        Exit Sub
    End If

hhxq001

zjdh 发表于 2014-8-16 18:18
只要插入：
    If Sheets.Count < 5 Then
        MsgBox "你还没有生成报表！"

做一下哦，不知道在哪儿插

su45

Private Sub 另存一遍_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Sheets.Count < 5 Then
        MsgBox "你还没有生成报表！"
        Exit Sub
    End If
    Workbooks.Add
    For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete

    Next

    With ThisWorkbook
        .Sheets(1).Cells.Copy ActiveSheet.Range("A1")
        ActiveSheet.Name = .Sheets(1).Name

        ActiveSheet.Buttons.Delete

        For i = 2 To .Sheets.Count
            Sheets.Add(After:=Sheets(i - 1)).Name = .Sheets(i).Name
            .Sheets(i).Cells.Copy ActiveWorkbook.Sheets(i).Range("A1")
        Next
    End With
    Do
        fname = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")   '选择另存报表的位置
    Loop Until fname <> False

     For Each ws In Worksheets
     If ws.Name Like "生成工具*" Then     '删除带"生成工具*"关键字的表
        ws.Delete

        Worksheets("花名册-数据源-勿删").Delete      '删除模板
        Worksheets("花名册模板-勿删").Delete
        Worksheets("审批表模板-勿删").Delete


    End If
    Next
    ActiveWorkbook.SaveAs fname

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "报表另存完毕！"
End Sub

zjdh

su45 发表于 2014-8-16 22:34
Private Sub 另存一遍_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts  ...

错啦！应该这样插，道理你自己明白。
Private Sub 另存一遍_Click()
    If Sheets.Count < 5 Then
        MsgBox "你还没有生成报表！"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Add
    For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
    ..................

hhxq001

发现你们说的位置都可以哦，有区别吗？

另外点击生成按钮生成的花名册的工作表标签颜色为红色，能在代码里改为无色或其他颜色吗？

zjdh

hhxq001 发表于 2014-8-17 10:29
发现你们说的位置都可以哦，有区别吗？

另外点击生成按钮生成的花名册的工作表标签颜色为红色，能在代码 ...

当然不一样！你不明白，14楼他知道！

zjdh

     Private Sub 生成新花名册_Click()
        ......
     
     With SH
        .Tab.ColorIndex = -4142
        ......
        End With
    End Sub

    Private Sub 多人一表_Click()
      ...........

    Sheets("审批表模板-勿删").Copy After:=Sheets(Sheets.Count)
    Set SH = ActiveSheet
    SH.Tab.ColorIndex = -4142
    If n = 1 Then  
                  
     ..........
   End Sub

su45

zjdh 发表于 2014-8-17 08:41
错啦！应该这样插，道理你自己明白。
Private Sub 另存一遍_Click()
    If Sheets.Count < 5 Then

确实，咱没想那么多！

hhxq001

zjdh 发表于 2014-8-17 13:23
Private Sub 生成新花名册_Click()
        ......
     

谢谢，相当好，佩服。