Как редактировать макрос "This Workbook" с другим макросом - PullRequest
0 голосов
/ 13 сентября 2018

Просто еще один вопрос, надеюсь, кто-то может помочь мне.

Для тех, кто помог мне в прошлом, я очень ценю это сообщество, и я рад быть отделенным от него.

Вотнекоторая справочная информация.

Я создал ~ 3200 рабочих книг Excel из основного списка (theFILE 1.1.xlsm), каждая рабочая книга была составлена ​​из строки в основном списке.

Теперь я могу редактировать листыи ячейки, использующие этот код;

Sub Macro2()

Application.ScreenUpdating = False

Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim FileName2 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "theFILE 1.1.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name

Const wsOriginalBook As String = "theFILE 1.1.xlsm"
Const sPath As String = "E:\theFILES\" 

SourceRow = 5

Do While Cells(SourceRow, "D").Value <> ""

FileName1 = wksSource.Range("A" & SourceRow).Value
FileName2 = wksSource.Range("K" & SourceRow).Value

sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

'Open Source Row's File
Set wb = Workbooks.Open(sFile)

'(INSERT CODE FOR SPECIFIED JOB)

'CLOSE WORKBOOK W/O BEFORE SAVE
Application.EnableEvents = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True

SourceRow = SourceRow + 1 ' Move down 1 row for source sheet

Loop

End Sub

Пожалуйста, примите к сведению мое отсутствие терминологии.

Я хотел бы иметь возможность использовать этот код, если это возможно, чтобы открывать каждую книгу и редактировать строки в пределах«Объекты Microsoft Excel» - «ThisWorkbook».Этот модуль, если его можно так назвать, содержит функцию BeforeSave, которая записывает некоторую информацию в скрытую электронную таблицу каждый раз, когда пользователь сохраняет.

Вот текущий макрос 'BeforeSave'

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim ws As Worksheet
Set ws = Sheets("EDITS")
Dim tbl As ListObject
Set tbl = ws.ListObjects("Table1")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add

    SavePrompt.Show

With newrow
    .Range(1) = Now
    .Range(2) = SavePrompt.TextBox1.Text
End With

Unload SavePrompt

End Sub

Мне нужно добавить .Range (3) = имя компьютера и .Range (4) = имя пользователя к этому.Мне нужно, чтобы каждая книга работала автономно, так как хост-компьютеры могут время от времени меняться, и другие не смогут повторно связывать или редактировать VBA.

Во-первых, можно ли редактировать «Объекты Microsoft Excel - ThisWorkbook»

Если так, то как?Я пробовал ThisWorkbook.VBProject.VBComponents ("ThisWorkbook"). CodeModule.insertLines 13, "Test"

... После разрешения Excel "Доверительный доступ к объектной модели проекта VBA" я получилВ уведомлении о том, что «в данный момент невозможно войти в режим прерывания», я выбрал «Продолжить», и моему компьютеру не понравился код, в то время как он открывал и закрывал каждую книгу, как обычно.В итоге добавилось «Test» в «ThisWorkbook» Мастера.В основной рабочей книге (theFILE 1.1.xlsm) нет макроса, поэтому он просто добавляется к следующей доступной строке из ее внешнего вида.

Затем я изменил последний код на;

ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 13, "Test"

Это, похоже, решает ошибки, но когда компьютер запускает код, он начинает зависать, и Excel начинает отображаться "Не отвечает .."

Так что, если это возможно ...Можно ли добавить / вставить строку и переместить предыдущие строки вниз на 1, как это делается в Excel при щелчке правой кнопкой мыши по строке?

Если Excel не позволяет редактировать строки в «ThisWorkbook», то какя полностью пересмотрю Объект?(удалить и импортировать обновленный объект)

1 Ответ

0 голосов
/ 14 сентября 2018
Sub Macro2() '''EDIT THE MACRO ON "ThisWorkbook" MODULE
Application.ScreenUpdating = False

Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim FileName2 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "theFILE 1.1.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name

Const wsOriginalBook As String = "theFILE 1.1.xlsm"
Const sPath As String = "E:\theFILES\" 'this is PATH(!REMEMBER! to include "\")

SourceRow = 5

Do While Cells(SourceRow, "D").Value <> ""

FileName1 = wksSource.Range("A" & SourceRow).Value
FileName2 = wksSource.Range("K" & SourceRow).Value

sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

Set wb = Workbooks.Open(sFile)

'''EDIT THE MACRO ON "ThisWorkbook" MODULE - FOR EACH PLANT's Workbook
'Deleting Lines
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 27
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 25
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 21
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 19
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 18
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 17
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 16
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 12
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 10

'Add DIM Lines
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 10, "'DIM SOME MORE OBJECTS"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 11, "Dim computername As String"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 12, "Dim username As String"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 13, "computername = Environ(""computername"")"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 14, "username = Environ(""username"")"

'Add the Lines Back
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 16, "    SavePrompt.Show"

ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 17, "'If SavePrompt.TextBox1 > 0 Then"

ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 18, "With newrow"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 19, "    .Range(1) = Now"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 20, "    .Range(2) = SavePrompt.TextBox1.Text"

'Add New Range LINES
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 21, "    .Range(3) = computername"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 22, "    .Range(4) = username"

'Continue Adding Lines back
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 24, "End With"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 25, "'ElseIf"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 26, "Unload SavePrompt"
ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 28, "End Sub"

'''CLOSE WORKBOOK W/O BEFORE SAVE
Application.EnableEvents = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True

SourceRow = SourceRow + 1 
Loop

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