Макрос VBA, прикрепленный к файлу - PullRequest
0 голосов
/ 04 октября 2018

У меня есть 9 макросов, которые используются для выполнения различных функций.Вот как я их использую:

  1. Поместите содержимое в лист Excel
  2. Запустите макросы, нажимая кнопки для форматирования и внесения изменений
  3. Скопируйте файл, удалитестарый контент и начать заново с новым контентом

У меня на листе есть кнопки, которые при нажатии запускают макрос и все работает нормально.Я решил убрать кнопки с листа (представьте 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

1 Ответ

0 голосов
/ 04 октября 2018

Вы можете использовать Application.ActiveWorkbook.Path только для самого пути (без имени книги) или Application.ActiveWorkbook.FullName для пути с именем книги.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...