[求助]如何制作自动提示上交报表？再次出现新问题出现，求助各位版主高手中......

secowu

那么这段代码是否还可以进行优化呢？Private Sub Workbook_open()

Dim a As String '将A定义为字符串

Dim mypath As String

Dim myfile As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Msg = "要现在上交报表吗？点是，将生成上交报表，点否将不生成报表。请在生成后检查！！！谢谢"

Style = vbYesNo + vbInformation + vbDefaultButton1

Title = "请在生成后检查！！！谢谢"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

    MyString = "Yes"

    a = Day(Now) - 1 '定义出需要复制的工作表名

    mypath = ThisWorkbook.Path ''获得当前文件存放的位置

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝    If Day(Now()) = 1 Then

    a = a + 1

    Sheets(Array(a, "黄小姐")).Select

    Sheets(a).Activate

    Sheets(Array(a, "黄小姐")).Copy

    ActiveWorkbook.SaveAs Filename:= _

        mypath & "\上交报表.xls", FileFormat:=xlNormal _

        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

        CreateBackup:=False＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝突然又想起代码中还存在着一个问题。那就是你要上交的报表是以今天的日期减去1得到的工作表名称（1-31），假设今天是2005-07-01,a=day(now)-1,则a=0;换句话说，VBA会找不到名称为"0"的工作表。所以建议是提交本日a=day(now)的报表，这样就不会有问题了

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    Else

    Sheets(Array(a, "黄小姐")).Select

    Sheets(a).Activate

    Sheets(Array(a, "黄小姐")).Copy

    ActiveWorkbook.SaveAs Filename:= _

        mypath & "\上交报表.xls", FileFormat:=xlNormal _

        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

        CreateBackup:=False

End If

Else

    MyString = "No"

    Sheets("黄小姐").Activate

End If

End Sub

晓月清风

If Day(Now()) = 1 Then

    a = a + 1这样写的话，a=2,复制的工作表是2，而不是1。根据你的设计意思，如果今天是2005年6月1日，是不是要复制工作表31(2005-5-31),也就是前一个月的最后一天?

晓月清风

如果是这样的话，具体代码如下：Private Sub Workbook_open()

Dim a As String '将A定义为字符串

Dim mypath As String

Dim myfile As String

Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Msg = "要现在上交报表吗？点是，将生成上交报表，点否将不生成报表。请在生成后检查！！！谢谢"

Style = vbYesNo + vbInformation + vbDefaultButton1

Title = "请在生成后检查！！！谢谢"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

    MyString = "Yes"

    a = Day(Now) - 1 '定义出需要复制的工作表名

    mypath = ThisWorkbook.Path ''获得当前文件存放的位置If a = 0 Then

a = Day(DateSerial(Year(Now), Month(Now), 0))

'求出上一个月最后一天的数值，如现在是6月，则上个月最后一天为31

End If

   

    Sheets(Array(a, "黄小姐")).Select

    Sheets(a).Activate

    Sheets(Array(a, "黄小姐")).Copy

    ActiveWorkbook.SaveAs Filename:= _

        mypath & "\上交报表.xls", FileFormat:=xlNormal _

        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

        CreateBackup:=False

Else

    MyString = "No"

    Sheets("黄小姐").Activate

End If

End Sub

晓月清风

代码优化如下：

Private Sub Workbook_open()

Dim a As String

If MsgBox("要现在上交报表吗？点是，将生成上交报表，点否将不生成报表。请在生成后检查！！！谢谢", vbOKCancel, "请在生成后检查！！！谢谢") = vbOK Then

   a = Day(Now) - 1

      If a = 0 Then

      a = Day(DateSerial(Year(Now), Month(Now), 0))

      End If

   Sheets(a).Activate

   Sheets(Array(a, "黄小姐")).Copy

   ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\报表.xls"

   Else

   Sheets("黄小姐").Activate

End If

End Sub

secowu

非常感谢晓月清风，

我怎么就没想到呢

原来，还要考虑上个月的那一天

由于目前在报表中，使用的是一个月一份总表，要上交的时候则复制前一天的工作表就可以了。

如果加上这一句

If a = 0 Then

      a = Day(DateSerial(Year(Now), Month(Now), 0))

当日期为月份的第一天时，打开报表的时候，比如打开的是当前月份的，则会出现找不到的现象

对吧？

由于这些报表，只能是当天做前一天的，因为当天的数据还没有全部出来。

所以，只能做前一天的，那交报表也就只能交前一天的。

那么，是否还可以做成别的格式？

因为，我发现一个月的报表31天算有5.6M之多，加上共享工作簿，两个人同时打开时就非常的慢

而报表里只是每个月的每天进行累计，但月不累计

所以， 有点烦。

我考虑过用ACCESS，可能会更好用。

但搞不定。

发个样表上来请大师帮忙看看

表里有变量，我想要是做成ACCESS，还得保留这些变量，可以进行随时更改。

做成固定，就麻烦的。

[此贴子已经被作者于2005-6-27 16:28:04编辑过]

晓月清风

不好意思，我对ACCESS不是很熟悉，不过你可以到这个论坛的ACCESS部分去求教

晓月清风

以下是引用secowu在2005-6-27 11:56:00的发言：

如果加上这一句

If a = 0 Then

a = Day(DateSerial(Year(Now), Month(Now), 0))

当日期为月份的第一天时，打开报表的时候，比如打开的是当前月份的，则会出现找不到的现象对吧？

加上这一句会提交当前工作簿中的以最后一天命名的工作表。之前，我没看过你的样表，以为这些表不全是同一个月的。

secowu

非常感谢热心帮助我还有个问题要请教由于负责做报表的星期天不上班，而报表的数据是每天都有的。所以，当星期一时，则要提交的报表至少有两天的。那么是否可以设定另外一个变量dim b as stringif weekday(now())=2 thenSheets(Array(a, b,"黄小姐")).Copy

    ActiveWorkbook.SaveAs Filename:= _

        mypath & "\上交报表.xls", FileFormat:=xlNormal _

        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _

        CreateBackup:=Falseendif那么这段，应该怎么嵌套进去呢？

晓月清风

Private Sub Workbook_open()

Dim a,b As String '多定义一个变量b

If MsgBox("要现在上交报表吗？点是，将生成上交报表，点否将不生成报表。请在生成后检查！！！谢谢", vbOKCancel, "请在生成后检查！！！谢谢") = vbOK Then

  a = Day(Now) - 1

   b = Day(Now) - 2

   If Weekday(Now) = 2 Then '判断是否为星期一

      Sheets(a).Activate

      Sheets(Array(a, b, "黄小姐")).Copy

      ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\报表.xls"

   Else      '如果不是星期一，则执行下列代码

      If a = 0 Then

      a = Day(DateSerial(Year(Now), Month(Now), 0))

      End If

   Sheets(a).Activate

   Sheets(Array(a, "黄小姐")).Copy

   ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\报表.xls"

   End If   '结束判断星期几

   Else

   Sheets("黄小姐").Activate

End If

End Sub

晓月清风

顺带一提，你的样表中有一句“Application.AutomationSecurity=3 ”是不是要将EXCEL安全级设置为最低，但是EXCEL并不支持这种方法.