У меня есть 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