设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 13230|回复: 57
打印 上一主题 下一主题

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

[复制链接]
跳转到指定楼层
1#
发表于 2005-6-24 19:43:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
这是自您晓月清风回复后(周五吧)再次新出现的问题:

麻烦看看下面的问题:

经过考虑,大概有下面情况:

If Day(Now) - 1 = 0 And Format(Worksheets("数值").Range("c2"), "yyyy-mm") = Format(Now, "yyyy-mm") Then

1.报表里的标记日期里的月份M1=当前系统日期里的月份时M2,并且A=0月初第一天时,提示打开正确的报表

2.报表里的标记日期里的月份M1=当前系统日期里的月份时M2,并且A<>0不是月初第一天时,

   分类:周一或非周一。执行报表复制:分日期是否为星期一,是则复制两天,否复制一天的

3.报表里的标记日期里的月份M1<>当前系统日期里的月份时M2,且M1+1=M2时,并且A=0月初第一天,执行报表复制

  分类:周一或非周一。执行报表复制:分日期是否为星期一,是则复制两天,否复制一天的

4.报表里的标记日期里的月份M1<>当前系统日期里的月份时M2,且M1+1<>M2时,并且A<>0非月初第一天,提示打开

5.报表里的标记日期里的月份M1=当前系统日期里的月份时M2,并且A<>0不是月初第一天时,执行报表复制

   分类:周一或非周一。 执行报表复制:分日期是否为星期一,是则复制两天,否复制一天的

如何把这些条件加入下面的代码里呢?我加了点,测试出现了一些错误,解决不了。谢谢

Private Sub Workbook_open()

Dim a As String

Dim b As String

Dim c As String ' 创建一个临时变量,以防出现生成的文件名为0号

Dim RptName1 As String

Dim RptName2 As String

Dim mypath As String

Dim Done As String '生成上交报表的日期与时间

Dim MyToday As String

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

RptName1 = Month(Now) & "月" & Day(Now) - 1 & "号"

RptName2 = Month(Now) & "月" & Day(Now) - 2 & "号"

Done = Now()

MyToday = Month(Now()) & "月" & Day(Now()) & "号" '将生成日期标记于生成的报表名称

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

Style = vbYesNo + vbInformation + vbDefaultButton1

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

If Day(Now) - 1 = 0 And Format(Worksheets("数值").Range("c2"), "yyyy-mm") = Format(Now, "yyyy-mm") Then

'检查打开的报表日期与系统日期相同,且为月初的第一天,则提示打开正确的报表

   MsgBox "本月是月初的第一天,请打开正确的报表并上交!谢谢"

   Application.Workbooks.Open (Application.GetOpenFilename)

  '如果点取消的话,会出现无法找到文件FALSE的提示,并导致宏出错,如何添加出错机制,允许取消?

Else

If Day(Now) - 1 = 0 And Format(Worksheets("数值").Range("c2"), "yyyy-mm") > Format(Now, "yyyy-mm") Then

'检查打开的报表日期与系统日期相同,且为月初的第一天,则提示打开正确的报表

   MsgBox "本月是月初的第一天,打开的报表月份与系统月份不一致,请打开正确的报表并上交!谢谢"

   Application.Workbooks.Open (Application.GetOpenFilename)

  '如果点取消的话,会出现无法找到文件FALSE的提示,并导致宏出错,如何添加出错机制,允许取消?

Else

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

If Response = vbYes Then

    MyString = "Yes"

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

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

If a = 0 And Format(Worksheets("数值").Range("c2"), "yyyy") = Format(Now, "mm") And Format(Worksheets("数值").Range("c2") - 1, "mm") = Format(Now, "mm") Then

'即判断当前日期是否为月初第一天,并且打开的工作表标记月份+1是否与系统月份相同。如果是则提醒打开上个月的报表

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

    c = Month(Now) - 1 '创建一个临时变量,以防出现生成的文件名为0号

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

    ActiveWorkbook.SaveAs Filename:= _

        mypath &amp

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2005-6-24 19:44:00 | 只看该作者
变量是a不是L弄错了。不好意思
3#
发表于 2005-6-25 16:08:00 | 只看该作者
ActiveWorkbook.SaveAs Filename:= _

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

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

        CreateBackup:=False

这句应改为:ActiveWorkbook.SaveAs Filename:= _

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

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

        CreateBackup:=False

另外,在SAVEAS一句中,如果这引起参数都不改变其默认值,也可以全部不写:Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

[此贴子已经被作者于2005-6-25 9:08:29编辑过]

4#
发表于 2005-6-25 16:08:00 | 只看该作者
在VBA中,format函数似乎只能用于图表
5#
发表于 2005-6-25 16:15:00 | 只看该作者
“L = Format(Now(), yyyy - mm) '求出系统当前的日期格式,为下面的寻找报表名字作准备”根据你的要求, 上面那一句可删除
6#
发表于 2005-6-25 16:18:00 | 只看该作者
另外,之所以会引用错误是因为 Dim a As Integer和Sheets(a).Activate产生的,一个是工作表的编号,而你要引用的却是工作表的名称。
7#
发表于 2005-6-25 16:20:00 | 只看该作者
修改后的代码如下: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 ''获得当前文件存放的位置    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

8#
发表于 2005-6-25 16:44:00 | 只看该作者
突然又想起代码中还存在着一个问题。那就是你要上交的报表是以今天的日期减去1得到的工作表名称(1-31),假设今天是2005-07-01,a=day(now)-1,则a=0;换句话说,VBA会找不到名称为"0"的工作表。所以建议是提交本日a=day(now)的报表,这样就不会有问题了
9#
发表于 2005-6-25 17:32:00 | 只看该作者
MyString = "No"这句也是多余的,因为对话框只给出两个选项--“是”或者“否”
10#
 楼主| 发表于 2005-6-25 18:35:00 | 只看该作者
非常感谢,那就得加段代码,首先判断当前日期如果当前日期day(now())=1的话,则变量A的值应该为A+1其余不变对吧?谢谢晓月清风的热心帮助!!!!!!!!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-26 03:41 , Processed in 0.100039 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表