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

工作流程

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

我尝试过的事情

验证继续进行的单元格被合并；我尝试过使用相同的验证代码添加新的工作簿验证合并的单元格，隐藏/显示“下拉列表”，手动应用验证还是使用代码，始终存在问题如果VBA创建并保存了工作簿，则仅重复
将文件另存为宏/非宏工作簿没有区别：（xlsx，xlsm）
尝试将代码复制到新模块中，以防损坏
使用.SaveAs命令指定/不指定Excel文件类型的实验；尝试了不同的文件类型过滤器

文件中的所有其他内容都符合预期

其他说明

使用Excel 2010；文件另存为xlsx;在Excel 2010上打开文件再次
我发现了另一个类似的线程，但是那里的问题与下拉框保持链接到源有关工作簿就我而言，这不会发生（我在代码中抢先了）因为在工作簿存在之前没有数据验证，并且已经包含所有复制的标签；宏添加数据验证并将其指向存在于工作簿。

其他人有没有解决此问题？

这是我在这里的第一篇文章，所以我希望我做得透彻。谢谢。

Answer 1

我找到了问题的根源：一些 other 数据验证正在通过我的标签复制，并且它们的Source（列表类型验证）仍链接到原始工作簿-这引起了错误当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

Excel VBA 2010：由VBA保存工作簿时，数据验证会中断，但手动保存时，数据验证不会中断

1 个答案: