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. 创建并保存新工作簿-“ Workbook-B”
2. 复制“ DropDowns”标签
3. 对于“主工作簿”中“工作簿A”中的每个选项卡，如果该选项卡标记为“使用”，则将其复制到工作簿B（尚无数据验证；仅是每个问题需要哪种响应类型的列表）
4. 对于Workbook-B中的每个选项卡，将工作表上的内容缩减到客户需要查看的内容（例如，删除未使用的问题），并应用与所选响应类型相对应的数据验证
5. 再次保存工作簿

我尝试过的事情

• 进行验证的单元将合并； 我已经尝试过使用相同的验证代码向合并的单元格添加验证，隐藏/显示“下拉列表”，手动验证以及使用代码的新工作簿，并且只有在VBA创建并保存了工作簿的情况下，问题才会再次出现
• 将文件另存为宏/非宏工作簿没有任何区别：（xlsx，xlsm）
• 尝试将代码复制到新模块中以防损坏
• 尝试在.SaveAs命令中指定/不指定Excel文件类型； 尝试了不同的文件类型过滤器

文件上的其他所有内容均符合预期

其他注意事项

• 使用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