Question

我有一个“主”工作簿，它有几个标签用于几个不同的订单处理任务。我过去的数据，运行一些宏，根据值格式化或添加列。然后我将当前工作表导出到基于单元格值变量命名的新预定义XLS文件。例如。 - 有一个“设置”表，其中包含导出工作表的路径和文件名。

我一直在使用以下代码，该代码基于某人的论坛帖子，略有修改。它使用旧的文件保存方法（有时会随机崩溃），是的我知道，但我不知道如何编写更新的代码。

问题是这些工作表显示活动的用户表单，其中包含执行任务的按钮。当工作表导出到新的XLS时，它由复制表方法完成，该方法继承了VBA“worksheet.activate”代码。当新书打开时，它会尝试运行不存在的用户表单。

我发现代码试图在此处和其他论坛上删除VBA，并且我在信任中心启用了受信任的VBA模型选项，但它不起作用。所以，基本上，我需要帮助找到一种方法将工作表的活动范围（没有空行）导出到新的XLS文件（每天都被覆盖，所以在技术上它不是“新文件”）使用单元格值，不是worksheet.copy方法。

Public Sub PrintExport()
Dim rng As Range
Dim wkb As Workbook
Dim sht As Worksheet
Dim EXPath As String

EXPath = ThisWorkbook.Worksheets("Settings").Range("B2")

Range("A2").Select
    If Range("A2") = "" Then
        MsgBox ("Not enough data.")
Exit Sub
Else

Set rng = ActiveSheet.UsedRange
On Error GoTo 0

    If Not rng Is Nothing Then
        fileSaveName = Application.GetSaveAsFilename(InitialFileName:=EXPath, filefilter:="xls Files (*.xls),*.xls,")


        'Application.GetSaveAsFilename(fileFilter:="xls Files (*.xls), *.xls")
        If fileSaveName <> False Then

            ActiveSheet.Copy
            Set wkb = ActiveWorkbook
            Set sht = wkb.ActiveSheet
            ActiveSheet.Name = "sheet1"
            sht.Cells.Delete
            rng.Copy sht.Range("A1")
          'this is where I tried the VBA delete code
            wkb.SaveAs fileSaveName, FileFormat:=xlExcel8
            wkb.Close
        End If
    End If
End If

我试过这个VBA删除代码但没有运气。

    With ThisWorkbook.VBProject.VBComponents(strName).CodeModule

                        .DeleteLines 1, .CountOfLines

Answer 1

假设您所指的“A2”范围位于“设置”表单上，您可以通过仅引用它来绕过选择它：

如果表格（“设置”）。范围（“A2”）=“”然后 MsgBox（“数据不够。”）退出子其他

另外，不确定为什么使用 fileSaveName = Application.GetSaveAsFilename 当我假设您希望文件在EXPath字符串中按照上面的定义命名时。知道您的工作簿有多个工作表我会遍历所有工作表以删除所有vba代码，外部链接，超链接和公式。（根据需要在此处进行调整）。

Dim EXPath As String
Dim nr As Name ' use this if you want to delete named ranges
Dim ws As Worksheet

EXPath = ThisWorkbook.Sheets("Settings").Range("F4") "set saved file name

    Sheets(Array("Settings")).Copy 'setup array of sheets w just the one sheet
On Error GoTo 0

    For Each ws In ActiveWorkbook.Worksheets
        ws.Cells.Copy
        ws.[A1].PasteSpecial Paste:=xlValues
        ws.Cells.Hyperlinks.Delete
        Application.CutCopyMode = False
        Cells(1, 1).Select
        ws.Activate
    Next ws
    Cells(1, 1).Select

     'Remove named ranges
    For Each nr In ActiveWorkbook.Names
        nr.Delete
    Next nr

     'Get rid of images,shapes w code
    ActiveSheet.Shapes.SelectAll
    Selection.Delete

    ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & EXPath & ".xlsx" 'modify this line
    ActiveWorkbook.Close savechanges:=False

将工作表导出到XLS而不复制VBA - 使用副本使用现有代码，需要帮助按范围复制

1 个答案: