VBA实现日期自动标记以及表格数据更新

新博客地址:https://gyrojeff.top,欢迎访问! 本文为博客自动同步文章,为了更好的阅读体验,建议您移步至我的博客👇

本文标题:VBA实现日期自动标记以及表格数据更新

文章作者:gyro永不抽风

发布时间:2020年09月02日 - 09:09

最后更新:2020年09月15日 - 08:09

原始链接:http://hexo.gyrojeff.moe/2020/09/02/VBA%E5%AE%9E%E7%8E%B0%E6%97%A5%E6%9C%9F%E8%87%AA%E5%8A%A8%E6%A0%87%E8%AE%B0%E4%BB%A5%E5%8F%8A%E8%A1%A8%E6%A0%BC%E6%95%B0%E6%8D%AE%E6%9B%B4%E6%96%B0/

许可协议: 署名-非商业性使用-相同方式共享 4.0 国际 (CC BY-NC-SA 4.0) 转载请保留原文链接及作者!

需求

  • 自动标记当前日期所在的列,高亮
  • 自动更新图标数据源

实现

使用ActiveX控件实现

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
'Get English Name of Column
Public Function Fun_GetEngName(ByVal argColumn As Integer) As String
Dim strEngName As String
Dim iNum, iMod As Integer

iNum = argColumn \ 26
iMod = argColumn Mod 26
If (iMod = 0) Then
If (iNum = 1) Then
strEngName = Chr(90)
Else
strEngName = Chr(65 + iNum - 2) + Chr(90)
End If
Else
If (iNum = 0) Then
strEngName = Chr(65 + iMod - 1)
Else
strEngName = Chr(65 + iNum - 1) + Chr(65 + iMod - 1)
End If
End If
Fun_GetEngName = strEngName
End Function

Private Sub CommandButton1_Click()
'Clear Background Color
Rows("1:1").Interior.ColorIndex = 2
Rows("2:2").Interior.ColorIndex = 2
'Get Current Date
Dim idate As Date
idate = Format(Now, "yyyy/m/d")
MsgBox "Today is " & idate & ", have a nice day!", , "Auto Dater, by H.Q."
'Set the bgcolor of the cell of current date
Worksheets(1).Cells(171, 3).Value = idate
Dim i
i = Worksheets(1).Cells(171, 5).Value
Worksheets(1).Cells(2, i).Interior.ColorIndex = 8
Worksheets(1).Cells(1, i).Interior.ColorIndex = 8
'Set data source of charts (till yesterday)
Dim s As String
s = Fun_GetEngName(i - 1)
ActiveSheet.ChartObjects("TimingStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$107:$" & s & "$111")
ActiveSheet.ChartObjects("SleepingStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$107:$" & s & "$107")
ActiveSheet.ChartObjects("EntertainmentStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$110:$" & s & "$110")
ActiveSheet.ChartObjects("StudyStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$108:$" & s & "$108")
ActiveSheet.ChartObjects("NormalStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$109:$" & s & "$109")
ActiveSheet.ChartObjects("TechStatistics").Activate
ActiveChart.SetSourceData Source:=Range("Main!$A$2:$" & s & "$2,Main!$A$111:$" & s & "$111")
End Sub

注意事项

效果

posted @ 2020-09-15 09:13  gyro永不抽风  阅读(581)  评论(0编辑  收藏  举报