Question

我有9个用于执行不同功能的宏。这就是我使用它们的方式：

将内容放入Excel工作表
按按钮运行宏以设置格式并进行更改
复制文件，删除旧内容，然后从新内容重新开始

我在工作表上有按钮，按下这些按钮可以运行宏，并且一切正常。我决定从工作表上删除按钮（想象一下工作表上的9个按钮）并将它们放在菜单中（通过自定义功能区）。但是，当我复制上一个文件，重命名它，删除内容并运行宏时，它们都链接到上一个表。

这里是宏之一。我不确定我要去哪里。我正在动态确定工作簿路径，然后根据该路径进行工作。当我在新工作表中运行代码时，工作簿路径也适用于我将宏放在菜单中的工作表。

我很好奇为什么会发生这种情况，我能做些什么来避免这种情况。

注意：我遇到过Activesheet，但听起来更像是一种解决方法。任何帮助将不胜感激。

Sub Seatholderpull()
    Dim tText As String, str() As String
    '(Done) Pull seatholder names from  documents
    ' (Done) Rename seat holder documents in
    'Cut Paste Seat Holder documents in  Folder
    workbookPath = ThisWorkbook.Path
    workbookPath = Left(workbookPath, Len(workbookPath) - 4)
    Set MyFSO = CreateObject("Scripting.FileSystemObject")
    pathFile = workbookPath & "\Cc Documents\"
    'MsgBox (pathfile)
    Set pptDeckApp = CreateObject("PowerPoint.Application")
    pptDeckApp.Visible = True

    Dim filename As String
    Dim i As Integer
    i = 1
    Dim k As Integer
    Set MyFolder = MyFSO.GetFolder(pathFile)
    Set MyFiles = MyFolder.Files
    'usageFileCheck = 0
    ' Open Usage File
    For Each myFile In MyFiles
        chkExtFound = 0
        chkReport = 0
        chkSH = 0
        chkExtFound = InStr(1, myFile.name, ".pptx", 1)
        chkReport = InStr(1, myFile.name, "Impact_Assessment_report", 1)
        MsgBox (myFile.name)
        'chkSH = InStr(1, myFile.name, nameSh, 1)
        If (chkExtFound <> 0 And chkReport <> 0) Then
            usageDeckDestination = pathFile & myFile.name
            On Error Resume Next

            'MsgBox (usageDeckDestination)

            Set usagedeck = pptDeckApp.Presentations.Open(usageDeckDestination)
            tText = (usagedeck.Slides(1).Shapes("Rectangle 5").TextFrame.TextRange.Text)
            'MsgBox (tText)


            str = VBA.Split(tText, vbCr)
            'MsgBox (str(2))
            If (Len(str(2)) < 2) Then
                str(2) = "Account"

                For k = 1 To 7
                    'MsgBox ("in For")
                    usagedeck.Slides(k).Select
                    titl = (usagedeck.Slides(k).Shapes.Title.TextFrame.TextRange.Text)
                    'MsgBox (titl)
                    If (InStr(1, titl, "Value Review from", 1) <> 0) Then
                        Worksheets("Seatholder Matrix").Cells(3, i).Value = usagedeck.Slides(k).Shapes("Group 58").Table.cell(3, 1).Shape.TextFrame.TextRange.Text
                        Exit For
                    End If
                Next

                i = i + 1
            End If

            'pull KI

            usagedeck.Close
        End If
    Next
End Sub

Answer 1

您可以将Application.ActiveWorkbook.Path仅用于路径本身（不包含工作簿名称），也可以将Application.ActiveWorkbook.FullName用于具有工作簿名称的路径。

附加到文件的VBA宏

1 个答案: