一个周历的表帮忙改改看，谢谢

eos5000

在函数公式版找到一贴，关于周历的，感觉不够合意，在原帖跟帖无果，特此在此发


改了一点界面，运行出错了。日期显示也不正常了 麻烦帮改一下

多数工作习惯，都是周一在前面，

上午，下午，晚上分开




后面还可以保存日志的，

eos5000

请帮助一下

蓝桥玄霜

请见代码。

eos5000

感谢回复，只是为什么用图形，发代码呢  

eos5000

蓝桥玄霜 发表于 2018-7-23 14:58
请见代码。

1. Private SubSpinButtonl_Change()
   
2. yy
   
3. Range("a2") = SpinButtonl.Value
   
4. End Sub
   
5. 
   
6. Function zrq(a As String) As Date
   
7. zrq = CDate(Left(a, 4) & "-01-01") + 7 * (Val(Right(a, 2)) - 1) - Weekday(CDate(Left(a, 4) & "-01-01")) + 2
   
8. End Function
   
9. 
   
10. 
    
11. Sub yy()
    
12. 
    
13. Dim xa$, zs, aa, bb
    
14. bb = [al].Value
    
15. zs = SpinButtonl.Value '
    
16. xa = bb & Format(zs, "00")
    
17. aa = zrq(xa) '
    
18. [b3] = aa
    
19. For i = 3 To 8
    
20.   Cells(3, i) = aa + i - 2
    
21. Next
    
22. End Sub
    

复制代码

我把您的代码搞成文字了，运转不了，麻烦您看一下

YZC51

粗略做了下
周历 -我想要的样式.rar (21.78 KB, 下载次数: 24)

2018-7-24 09:34 上传

点击文件名下载附件

YZC51

eos5000 发表于 2018-7-23 19:42
我把您的代码搞成文字了，运转不了，麻烦您看一下

修正了抄写的
Private Sub SpinButton1_Change()
    yy
    Range("a2") = SpinButton1.Value
End Sub

Function zrq(a As String) As Date
    ncrq = DateSerial(Left(a, 4), 1, 1)
    zrq = ncrq + 7 * Val(Right(a, 2)) - Weekday(ncrq, 1) - 5
End Function

Sub yy()
    Dim xa$, zs, aa, bb
    bb = [a1].Value
    Sheets("日志").Range("A2") = zrq(bb & "01")
    zs = SpinButton1.Value '
    xa = bb & Format(zs, "00")
    aa = zrq(xa) '
    [b3] = aa
    For i = 3 To 8
        Cells(3, i) = aa + i - 2
    Next
End Sub

eos5000

YZC51 发表于 2018-7-23 20:26
粗略做了下

非常感谢，我看了一下代码，发现，你改动得太巧妙了，把问题简单化了。
试用成功，不过发现一个新问题，应该是按钮保存，才进入日志，不然，误操作倒退周，的时候，就把原来的纪录抹掉了

eos5000

修改了一下，可以用了，非常感谢各位,发现上传错了，重新上传。

YZC51

6楼已经更新！请重新下载。