Excel VBA 2010: проверка данных прерывается при сохранении книги VBA, но не при ручном сохранении

Question

КОНТЕКСТ И ЧТО РАБОТАЕТ РАБОТА У меня есть рабочая тетрадь для создания анкет;пользователь выбирает из списков вопросов на нескольких вкладках, а затем запускает макрос, который объединяет выбранные вопросы в новую рабочую книгу;пользователь отправит новую «опубликованную» рабочую книгу своему клиенту.Тип ответа также может быть выбран с вопросами;например, «Да / Нет», «1 - 5 баллов» и т. д. При сопоставлении вопросов и вкладок тип ответа добавляется в новую рабочую книгу в качестве проверки данных;вкладка с раскрывающимися списками существует в новой рабочей книге и скрыта.

ПОВЕДЕНИЕ Я ВИДЮ Все работает, пока книга еще открыта после создания;однако, когда я закрываю и снова открываю, я получаю стандартную ошибку «Обнаружено нечитаемое содержимое ... Вы хотите восстановить ...» Восстановление с помощью Excel удаляет все данные проверки со всех вкладок!Это происходит только , когда файл создается и сохраняется через VBA ;Создание и сохранение файлов вручную Я не получаю эту ошибку.Я также, например, попытался использовать тот же код VBA для добавления проверки данных в новую книгу, созданную мной, и эта проблема не возникает.

Примечания к коду;Рабочий процесс и то, что я пробовал, следуют:

Код для создания и сохранения новой книги

outFileName = Application.GetSaveAsFilename(InitialFileName:=standardName, FileFilter:="Excel Files (*.xlsm), *.xlsm", Title:="Save As")

If outFileName = "FALSE" Then
    MsgBox ("Export NOT completed")
    GoTo endSafely
Else
outFileName = outFileName
End If

Set outBook = Workbooks.Add

'Activate and save the workbook
outBook.Activate
outBook.SaveAs Filename:=outFileName, FileFormat:=52

Код для применения проверки данных

    Sub addResponseFormatting(targetBook, targetSheet, targetRow, targetColumn, typeResponse)


Set targetBook = Workbooks(targetBook)
Set thisBook = Workbooks(ThisWorkbook.Name)

'---------------------------------------------------------------------------------------------------
'  PROCESS
'---------------------------------------------------------------------------------------------------

targetBook.Activate
targetBook.Sheets(targetSheet).Activate

Dim targetCell As Range

With targetBook.Sheets(targetSheet).Cells(targetRow, targetColumn).Validation


    Select Case typeResponse

        Case "Yes/No"

                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=DropDowns!$D$4:$D$5"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True


        Case "1 to 5"

                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=DropDowns!$C$4:$C$8"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True

        Case Else
            'Do nothing; leave open as free text
            'Removes all validation; note this may also remove tooltip messages if we've applied these
            .Delete
    End Select

End With


End Sub

Рабочий процесс

1. Создание и сохранение новой рабочей книги - "Рабочая книга"-B "
2. Скопировать вкладку« DropDowns »через
3. Для каждой вкладки в основной рабочей книге« Рабочая книга A », если вкладка помечена как« Использовать », скопировать вкладку в Workbook-B (нетпроверка данных еще не завершена, просто список рядом с каждым вопросом о том, какой тип ответа требуется)
4. Для каждой вкладки в Рабочей книге-B вырежьте содержание на листе до того, что клиент должен видеть (например, удаляя неиспользованные вопросы)и примените проверку данных, соответствующую выбранному типу ответа
5. Сохраните книгу снова

То, что я пробовал

• Ячейки, на которых идет проверка, объединяются;Я экспериментировал со свежей книгой, используя тот же код проверки, чтобы добавить проверку к объединенным ячейкам, скрыть / показать раскрывающийся лист, применить проверку вручную по сравнению с кодом, и проблема всегда повторяется только , если VBA создалаи сохранил книгу
• Сохранение файла как макроса / немакро книги не имеет значения: (xlsx, xlsm)
• Попытка копирования кода в новый модуль в случае повреждения
• Экспериментировал с указанием / не указанием типа файла Excel в команде .SaveAs;пробовал фильтры разных типов файлов

Все остальное в файле, как и ожидалось

Другие примечания

• Использование Excel 2010;файл сохраняется как xlsx;файл снова открывается в Excel 2010
• Я нашел другую похожую ветку, однако проблема была связана с тем, что выпадающие списки оставались связанными с исходной рабочей книгой;в моём случае этого не произойдет (я упустил в своем коде), потому что нет подтверждения данных до тех пор, пока книга не существует и в нее уже не вставлены все скопированные вкладки;макрос добавляет проверку данных и указывает на вкладку DropDowns, существующую в книге.

Кто-нибудь еще имел и исправил эту проблему?

Это мой первый пост здесь, поэтому янадеюсь, что я был тщательнымСпасибо.

Answer 1

Я нашел корень проблемы: некоторые другие проверки данных копировались на мои вкладки, и их Источник (проверка типа списка) все еще был связан с исходной книгой - это вызвало ошибку икогда Excel пытается восстановить файл, он удаляет все данные проверки из вкладки (не только с ошибкой).

Чтобы определить, какие ячейки получили и потеряли проверку данных, я использовал этот простой бит кода для выделения ячеек с проверкой:

Подпрограмма (функция проверки данных)следует)

Sub runascan()

Set targetBook = Workbooks("test25")

targetBook.Activate

For Each sheetsIn In targetBook.Sheets

    sheetsIn.Activate

    For Each cellin In Range("A1:Z100")

        If checkVal(cellin) = 1 Then
            cellin.Interior.Color = RGB(0, 255, 0)
        Else

        End If
   Next cellin

Next sheetsIn

End Sub

Функция проверки правильности данных в ячейке

Function checkVal(tRange)

Workbooks(ThisWorkbook.Name).Activate

x = 0
On Error Resume Next
x = tRange.SpecialCells(xlCellTypeSameValidation).Count

On Error GoTo 0

If x = 0 Then
    checkVal = 0
Else
    checkVal = 1
End If

End Function