Исключить диалоговое окно выбора папки при запросе обновления листа (который я не хочу обновлять)

Question

У меня есть программа, которая ежедневно экспортирует между 8-12 книгами Excel с разными именами.

В каждой из этих книг есть лист с именем "A".

Эти рабочие книги размещены в папке на рабочем столе пользователя, и VBA предложит пользователю найти указанную папку. Затем файл за файлом откроет каждую рабочую книгу и добавит лист под названием «Ввод данных строительства», а затем еще один лист под названием «график».

Когда эти листы открываются по одному, он будет копировать формулы (A1: AZ1000) из основного файла Excel (другой рабочей книги (в которой также есть листы «Ввод данных строительства» и «Расписание») и копировать их в рабочие книги, которые пользователь поместил в папку на своем рабочем столе (те, которые содержат лист «А»).

В заключение я добавляю листы из основной рабочей книги Excel в другие рабочие книги Excel, а затем копирую формулы в их и ломая ссылки на листы.

Все вышеперечисленное работает, как и предполагалось.

Однако, когда я запускаю код, средство выбора файлов открывается дважды для каждой книги, чтобы обновить лист «А». Я не хочу редактировать или обновлять лист "A", и если я нажму кнопку "Отмена" в диалоговом окне папки с файлами, это не произойдет.

Моя цель состоит в том, чтобы исключить необходимость выбора пользователем кнопки "Отмена". в диалоговом окне выбора папки с файлами (по 2 раза каждый файл 8-12 раз в день)

Бонус: некоторые из моих файлов имеют массивы и средство проверки совместимости всплывает. Есть ли способ конвертации по умолчанию с использованием VBA?

Я считаю, что ошибка заключается либо в строке set sh, либо в строке set nws.

Private Sub BtnAddWorksheets_Click()
Dim file_count As Long
Dim file_name As String
Dim check_path As String
Dim count_files As Integer
Dim NewWB As Workbook
Dim MasterWB As Workbook
Dim sh As Worksheet
Dim i As Integer
Dim x As Integer

check_path = Navigator.TxtFilePath
MsgBox (check_path)

file_name = Dir(check_path & "\" & "*")

file_count = 0

'MsgBox (check_path & "\" & file_name) - verified this is the full path

Do While file_name <> ""

    'open workbook
    Set MasterWB = ThisWorkbook
    Set NewWB = Workbooks.Open(Filename:=check_path & "\" & file_name)
    'The correct Excel file opens

    'Ensure workbook has opened before doing next line of codes
    '
    NewWB.Sheets.Add After:=NewWB.Worksheets(NewWB.Worksheets.Count)
    ActiveSheet.Name = ("Enter Construction Data")
    Set sh = ThisWorkbook.Worksheets("Enter Construction Data")
    Set nws = Sheets("Enter Construction Data")

    With sh.Cells.Copy
    End With

    With nws.Cells
        .PasteSpecial Paste:=xlPasteFormulas
        .PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        'Application.CutCopyMode = False
    End With

    'Eliminate the Previous workbook reference
    Sheets("Enter Construction Data").range("A1:AZ1000").Select
    Selection.Replace What:="[NavigatorFormBuild.xlsm]", Replacement:="", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False

    Set sh = Nothing
    Set nws = Nothing

    NewWB.Sheets.Add After:=NewWB.Worksheets(NewWB.Worksheets.Count)
    ActiveSheet.Name = ("Schedule")

    Set sh = ThisWorkbook.Worksheets(3)
    Set nws = Sheets("Schedule")

    With sh.Cells.Copy
    End With

    With nws.Cells
        .PasteSpecial Paste:=xlPasteFormulas
        .PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        'Application.CutCopyMode = False
    End With

    'Eliminate the Previous workbook reference
    Sheets("Schedule").range("A1:AZ1000").Select
    Selection.Replace What:="[NavigatorFormBuild.xlsm]", Replacement:="", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False

    NewWB.Close (savechanges = False)

    Set MasterWB = Nothing
    Set NewWB = Nothing

    file_count = file_count + 1
    file_name = Dir

    If count_files = file_count Then
        Exit Sub
    End If

Loop

count_files = -1

End Sub

В этом диалоговом окне открывается два раз в листе - это единственное, что я пытаюсь исключить из кода.

Изображение, показывающее диалог из запуска кода.

Изображение показывает окно с ошибкой, отсутствует источник для обновления вкладки «А».

Answer 1

Я нашел ответ! Этот сайт помог мне разобраться в проблеме. https://docs.microsoft.com/en-us/office/troubleshoot/excel/control-startup-message

Это была многогранная проблема. Сначала я не осознавал, что индекс листа для листа «А» в одной рабочей книге был (1), а в другой рабочей книге - (9). Чтобы это исправить, я просто добавил лист в книгу, в котором отсутствовал индекс листа (1), и оставил имя по умолчанию «Sheet1». Как только я это сделал, у меня был лист с индексом (1) в обеих книгах. Это активировало кнопку «Разрыв связи» в следующем окне:

Окно «Редактировать ссылки» - ссылка в прикрепленной статье.

Далее я нажал кнопку «Разорвать связь» и искал листы для #REF! как @ CDP1802 указано выше. Это привело меня к одной ячейке «А1» на листе «Ввод данных конструкции». Я перепечатал формулу: =A!A1 в этой ячейке, и в следующий раз, когда я выполнил VBA, он только открыл проверку совместимости windows (в этот момент порядок листов был испорчен, чтобы исправить, я просто удалил "Sheet1" - лист, созданный для получения общего индекса.) Теперь формулы массива отлично переносятся между книгами.

@ CDP1802 - ваш код мог работать, чтобы разорвать ссылки, если эти индексы были установлены в обеих книгах, когда я первоначально пытался запустить ваш код. Я очень ценю вашу помощь в решении вопросов по этому вопросу!

Итоговый код:

Private Sub BtnAddWorksheets_Click()
Dim file_count As Long
Dim file_name As String
Dim check_path As String
Dim count_files As Integer
Dim NewWB As Workbook
Dim MasterWB As Workbook
Dim sh As Worksheet
Dim i As Integer
Dim x As Integer
Dim ExcelFileName As String

ExcelFileName = ThisWorkbook.Name

check_path = Navigator.TxtFilePath

file_name = Dir(check_path & "\" & "*")

file_count = 0

'MsgBox (check_path & "\" & file_name) - verified this is the full path

Application.ScreenUpdating = False

Do While file_name <> ""

'open workbook
    Set MasterWB = ThisWorkbook
    Set NewWB = Workbooks.Open(FileName:=check_path & "\" & file_name)

'The correct Excel file opens

'Adds sheet "Enter Construction Data" to workbooks
NewWB.Sheets.Add After:=NewWB.Worksheets(NewWB.Worksheets.Count)

ActiveSheet.Name = ("Enter Construction Data")
    Set sh = ThisWorkbook.Worksheets(2)
    Set nws = Sheets("Enter Construction Data")

With sh.Cells.Copy
End With


With nws.Cells
    .PasteSpecial Paste:=xlPasteFormulas
    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
End With

'''''Eliminate the Previous workbook reference
Sheets("Enter Construction Data").Range("A1:AZ1000").Select
Selection.Replace What:="[" & ExcelFileName & "]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

sbProtectSheet

Set sh = Nothing
Set nws = Nothing


'Adds sheet "Schedule" to workbooks
NewWB.Sheets.Add After:=NewWB.Worksheets(NewWB.Worksheets.Count)
ActiveSheet.Name = ("Schedule")

    Set sh = ThisWorkbook.Worksheets(3)
    Set nws = Sheets("Schedule")

With sh.Cells.Copy
End With



With nws.Cells
    .PasteSpecial Paste:=xlPasteFormulas
    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme

End With

''''''Eliminate the Previous workbook reference
Sheets("Schedule").Range("A1:CA100").Select
Selection.Replace What:="[" & ExcelFileName & "]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

sbProtectSheet

Worksheets("A").Activate
sbProtectSheet

Worksheets("Enter Construction Data").Activate

ActiveWorkbook.CheckCompatibility = False

NewWB.Close SaveChanges:=True

    Set MasterWB = Nothing
    Set NewWB = Nothing

file_count = file_count + 1
file_name = Dir

If count_files = file_count Then
count_files = -1
Exit Sub
End If

Loop

Application.ScreenUpdating = True
Unload Navigator

End Sub

Спасибо, СО Сообщество!

Answer 2

Выбор файлов открывается из-за ссылок на основную рабочую книгу. Удалите код replace и добавьте его перед сохранением книги.

' remove links
msg = ""
aLinks = NewWB.LinkSources
If Not IsEmpty(aLinks) Then
    For j = 1 To UBound(aLinks)
        If InStr(aLinks(j), "[NavigatorFormBuild.xlsm]") > 0 Then
            NewWB.BreakLink aLinks(j), xlLinkTypeExcelLinks
            msg = msg & vbCr & aLinks(j)
        End If
    Next j
    If Len(msg) > 0 Then MsgBox "Links broken " & msg, vbInformation
End If