如何使用 excel VBA 中的图标（形状）在月份之间导航？

Question

我在同一个 sheet 中创建了多个 table，每个 table 都将其分配给一个月，另外还有两个图标（两种形状）可以导航到下个月或上个月。我需要的是使用这两个图标（next/previous 月）循环浏览月份。例如，如果用户需要一月，将显示列 (B:AD) 并隐藏重置，其他月份以此类推。

Columns to be shown: January (B:AD) February(AF:BH) March(BJ:CL) April(CN:DP) May(DR:ET) June(EV:FX) July(FZ:HB) August(HD:IF) September(IH:JJ) October(JL:KN) November(KP:LR) December(LT:MV)

这是我 excel 的 link： https://1drv.ms/x/s!Av2jQlwHZCT3gjeo3q_Po99tvoSr?e=vICkeT

Answer 1

试试这个代码：

Sub go_right()  'assign to the right triangle
    ShiftMonth 1
End Sub

Sub go_left()   'assign to the left triangle
    ShiftMonth -1
End Sub

Sub ShiftMonth(direction As Integer)
    Const PERIOD = 30                   'the number of columns for each month
    Const TEXT_BOX_NAME = "TextBox 1"   'your textbox (with month) name
    With ThisWorkbook.Worksheets("MER Monthly Tracker")
        cur = Val(.Range("A1").ID)      '.Range("A1").ID uses to store the current month number (0..11)
        cur = Evaluate("MOD(" & cur + direction & "," & 12 & ")") ' get the target month number according to direction
        .Range("A1").ID = cur           'store the new month number
        
        Application.ScreenUpdating = False
        .Columns(2).Resize(, 12 * PERIOD).Hidden = True             'hide all columns
        .Columns(2 + cur * PERIOD).Resize(, PERIOD).Hidden = False  'show columns with target month
        .Shapes(TEXT_BOX_NAME).TextFrame2.TextRange.Text = .Cells(3, 2 + cur * PERIOD + 2) ' set the name of month
        Application.ScreenUpdating = True
    End With
End Sub

Note that triangles and TextBox should have the "Do not move or resize with cells" property, so that these shapes will not be hidden when hiding columns

Answer 2

请尝试下一种方式：

您向左移动的形状应命名为“等腰三角形 1”，向右移动的形状应命名为“等腰三角形 2”。该矩形应命名为“MonthsRect”！当然，您必须选择“不移动或调整单元格大小”形状属性。右键单击 -> 大小和属性 -> 属性（来自 'Size & properties' 部分...）。
请复制标准模块中的下一个代码：

Option Explicit

Dim sh As Worksheet, arrMonths, shMnth As Shape
Private Const strMonths = "January,February,March,April,May,June,July,August,September,Octomber,November,December"
Private Const strCols = "B:AD,AF:BH,BJ:CL,CN:DP,DR:ET,EV:FX,FZ:HB,HD:IF,IH:JJ,JL:KN,KP:LR,LT:MV"

Sub PreviousMonth()
    MoveMonths "prev"
End Sub
Sub NextMonth()
    MoveMonths "next"
End Sub
Function MoveMonths(dir As String)
 Dim existM As String, NextM As String, mtch, arrCol
   existM = actualMonths
   mtch = Application.match(existM, arrMonths, 0)
     If mtch = 1 And dir = "prev" Then
        NextM = "December"
    ElseIf mtch = 12 And dir = "next" Then
        NextM = "January"
     Else
        NextM = Application.Index(arrMonths, mtch + IIf(dir = "prev", -1, 1))
     End If
     shMnth.TextFrame2.TextRange.Text = NextM & ", 2021"
     'hide columns:
     sh.Range("A1:MV1").EntireColumn.Hidden = True
     mtch = Application.match(NextM, arrMonths, 0)
     arrCol = Split(strCols, ",")
     sh.Range(arrCol(mtch - 1)).EntireColumn.Hidden = False
     Application.Goto sh.Range("A1")
End Function
Function actualMonths() As String
    Dim actMonth As String
     If Not IsArray(arrMonths) Then
        arrMonths = Split(strMonths, ",")
     End If
     If sh Is Nothing Then Set sh = ActiveSheet
     If shMnth Is Nothing Then Set shMnth = sh.Shapes("MonthsRect")
     actualMonths = Split(shMnth.TextFrame2.TextRange.Text, ",")(0)
End Function

请分配以上两个（雄辩地命名）。 “PreviousMonth”到左边的三角形，“NextMonth”到右边的三角形。您可以右键单击形状，选择 Assign Macro...，在 'Macros in:' 处选择 'This workbook'，单击相应的子项并按“确定”。

你没有回答我关于当活跃月份是“一月”并按左三角，或“十二月”并按右三角时会发生什么的澄清问题。上面的代码将在第一个案例中跳转到“December”，在第二个案例中跳转到“January”。理论上，您可以减少年份并从另一个 sheet...

获取数据

请玩玩这两个三角形并发送一些反馈

如何使用 excel VBA 中的图标（形状）在月份之间导航？

How to navigate between months using icons (shapes) in excel VBA?

navigation

excel

vba