Question

我只想弄清楚是否有办法更改目标单元格以运行相同的代码。这段代码基本上打开了一个基于单元格 A1 的目录文件夹，但我想要发生的是在同一行上添加一个宏按钮，该行使用该行上单元格的值。（例如，我的代码使用 A1 上的数据，如果我将宏按钮放在第2行，我希望代码对 A2 执行相同的操作）

Sub OpenFolder()

    Dim MyFolder As String
    Dim JobNumber As String
    Dim JobYearLeft As String
    Dim JobYear As String
    Dim FolderNumber As String
    Dim i As Integer
    Dim FirstFolder As String

    JobNumber = Right(Range("A1"), Len(Range("A1")) - 3)
    JobYearLeft = Right(Range("A1"), Len(Range("A1")) - 1)
    JobYear = Left(JobYearLeft, Len(JobYearLeft) - 4)

    i = CInt(JobNumber)

    Select Case i
        Case 0 To 500
        FolderNumber = "0001_0500"
            Case 500 To 1000
            FolderNumber = "0501_1000"
                Case 1000 To 1500
                FolderNumber = "1001_1500"
                    Case 1500 To 2000
                    FolderNumber = "1501_2000"
    End Select


    If (JobYear = 17) Then
        FirstFolder = "M:\2017\" & FolderNumber & "\" '& Range("A1").Value & "*" & "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\" '& Range("A1").Value & "*" & "\"
    End If

    If (JobYear = 17) Then
        MyFolder = "M:\2017\" & FolderNumber & "\" & Range("A1").Value & "*" '& "\"
    Else
        MyFolder = "M:\2016\" & FolderNumber & "\" & Range("A1").Value & "*" '& "\"
    End If

    MyFolder = Replace(MyFolder, " ", "")

    Dim OpenThisFolder As String
    Dim GoToFolder As String

    MyFolder = Dir(MyFolder, vbDirectory)

    GoToFolder = FirstFolder & MyFolder & "\"
    GoToFolder = Replace(GoToFolder, " ", "")
    ActiveWorkbook.FollowHyperlink GoToFolder

End Sub

Answer 1

您可以创建一些Subs（每个按钮一个），可以调用您的Main Sub（这是您发布的代码）并传递给包含您的单元格变量的变量。像这样：

Sub ButtonForRow1()
    MainSub "A1"
End Sub

Sub ButtonForRow2()
    MainSub "A2"
End Sub

Sub MainSub(TargetCell as String)
    (...)
    JobNumber = Right(Range(TargetCell), Len(Range(TargetCell)) - 3)
    (...)
End Sub

希望这有帮助！

Answer 2

如评论所述，您可以尝试这样的事情。以下是您需要的东西？

表单按钮名为按钮1 （或您想要的任何其他名称，只需确保在下面的代码中正确指定）。

每次选择单元格时定位按钮的代码，然后分配单击时将执行的操作。在图表模块（处理数据的工作表）中的代码下面就是这样。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    On Error GoTo sureexit
    Dim myButton As Shape, myAction As String

    Application.EnableEvents = False
    Set myButton = Me.Shapes("Button 1") '/* used a form control button */

    If Not Intersect(Target, Me.Range("B1:B10")) Is Nothing Then
        '/* target cell is on B1:B10, to get A1:A10 offset by -1 */
        myAction = "'OpenFolder(Evaluate(""" & _
                   Target.Offset(, -1).Address & """))'"
        '/* move the button to the selected cell */
        With myButton
            .Top = Target.Top
            .Height = Target.Height
            .Left = Target.Left
            .Width = Target.Width
            .OnAction = myAction
            .TextFrame.Characters.Text = "Follow"
            .Visible = msoCTrue
        End With

    Else
        '/* hide button if selected cell is not between B1:B10 */
        myButton.Visible = msoFalse
    End If

sureexit:
    Application.EnableEvents = True

End Sub

当然，您需要一个常规模块中的程序，您可以在按钮1 中动态分配该程序。下面是一个简单的过程，它需要1个范围参数。
```
Sub OpenFolder(r As Range)

    MsgBox r.Address & ": " & r.Value2

End Sub
```

您可以将此程序与您的程序合并，将所有Range("A1")更改为每次单击按钮时传递的变量r。希望这能帮到你。

在VBA Excel上更改目标单元格

2 个答案: