Excel VBA 2010 : Data validation breaks when workbook saved by 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. 复制“下拉菜单”选项卡
3. 对于主工作簿“工作簿 A”中的每个选项卡，如果选项卡标记为“使用”，则将选项卡复制到工作簿-B(尚未进行数据验证；只是每个问题旁边的一个列表，其中列出了所需的响应类型)<
4. 对于工作簿-B 中的每个选项卡，将工作表上的内容缩减为客户需要查看的内容(例如删除未使用的问题)，并应用与所选响应类型对应的数据验证
5. 再次保存工作簿

我尝试过的事情

• 验证进行的单元格被合并；我试验过使用新的工作簿使用相同的验证码添加验证合并单元格，隐藏/显示下拉表，手动应用验证与代码应用验证，问题总是仅如果 VBA 创建并保存了工作簿
• 将文件保存为宏/非宏工作簿没有区别:(xlsx, xlsm)
• 尝试将代码复制到新模块以防损坏
• 尝试在 .SaveAs 命令中指定/不指定 Excel 文件类型；尝试了不同的文件类型过滤器

文件上的其他一切都符合预期

其他注意事项

• 使用 Excel 2010；文件保存为 xlsx；文件在 Excel 2010 中打开再次
• 我发现了另一个类似的线程，但该问题与保持与源链接的下拉框有关工作簿；这不会发生在我的情况下(我在我的代码中先发制人)因为在工作簿存在之前没有数据验证并且已经将所有复制的选项卡放入其中；宏添加数据验证并将其指向存在于工作簿。

有没有其他人遇到并解决了这个问题？

这是我在这里的第一篇文章，所以我希望我已经很透彻了。谢谢你。

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