VBA80集第10集练习上交专贴（正确答案奖励20金币）

exceltl

66666

cq7212

xuexile

qq896973200

Sub 日报表格式生成()
Dim x As Integer, ash As Worksheet
On Error Resume Next
For x = 1 To Sheets.Count
    If Right(Sheets(x).Name, 3) = "日报表" Then
        Sheets("日报表模板").Visible = True
        Sheets("日报表模板").Copy after:=Sheets(Sheets.Count)
        Set ash = ActiveSheet
        ash.Name = Sheets.Count - 2 & "日报表"
        Sheets("日报表模板").Visible = False
        Exit Sub
    End If
Next x
Sheets("日报表模板").Visible = True
Sheets("日报表模板").Copy after:=Sheets(Sheets.Count)
Set ash = ActiveSheet
ash.Name = "1日报表"
Sheets("日报表模板").Visible = False
End Sub


Sub 另存报表()
Dim wb As Workbook, x As Integer, a As String
On Error Resume Next
For x = 1 To Sheets.Count
a = Sheets(x).Name
    If Right(a, 3) = "日报表" Then
        If Len(Dir(ThisWorkbook.Path & "\" & a & ".xls")) = 0 Then
            Sheets(x).Copy
            Set wb = ActiveWorkbook
            wb.SaveAs ThisWorkbook.Path & "\" & a & ".xls"
            wb.Close True
        End If
    End If
Next x
End Sub

耿江惠

请老师批阅
Sub 日报表格式生成()
Sheets("日报表模板").Visible = True
Sheets("日报表模板").Copy after:=Sheets(Sheets.Count)
Dim sh As Worksheet, x As Integer
Set sh = ActiveSheet
x = Sheets.Count
sh.Name = (x - 2) & "日报表"
sh.Visible = True
Sheets("日报表模板").Visible = False
End Sub

Sub 另存报表()
Dim wb As Workbook, x As Integer
For x = 3 To Sheets.Count
    Sheets(x).Copy
    Set wb = ActiveWorkbook
    wb.SaveAs ThisWorkbook.Path & (x - 2) & "日报表.xls"
    wb.Close True
Next x
End Sub

panmiaomiao

HAO

Nickley

我来学习

竹韵zm

交作业啦

yydyzsh

好久的帖子了

76868850

来看看，学习哦。

liux2343

来学习一下