首页 > 解决方案 > 如何应用 Worksheets.SaveAs 功能?

问题描述

我正在编写一个脚本,将一个范围从我的基本表导出到特定的工作表。(使用 while 循环检查和创建工作表的名称。如果名称已经存在,则内容将被清除并重新粘贴。)

最后一步是将范围保存到 .txt 文件中,但它给出了

'运行时错误'1004'
应用程序定义或对象定义'错误

我搜索了类似的错误,但无法解决。

#更新

在评论中提出建议后,我更新了代码以显示更改。

我明白了

运行时错误“438”
对象不支持此属性或方法

Option Explicit ' Force explicit variable declaration.

Sub test_wh()    
    Dim exportFolder As String
    Dim filedialog As filedialog
    Dim fd
   
    Set fd = Application.filedialog(msoFileDialogFolderPicker)
    
    With fd
        .Title = "Select folder for export wh and wg files"
        If .Show = True Then
            exportFolder = .SelectedItems(1)
        End If
    End With
    
     '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

    Dim nameSheet As String
    Dim baseSheet As String: baseSheet = "BASE"
    Dim actSheet As String
    Dim f As Integer
    Dim i As Integer
    Dim x As String
        
    actSheet = ActiveSheet.Name
    
    i = 30
    f = 0

    Do While i < 361
        x = "wh" & i

        If Len(nameSheet) < 5 Then
            nameSheet = "wh0" & i
        End If

        If DoesSheetExists(nameSheet) Then
            Worksheets(nameSheet).range("A1:B27").ClearContents
            Worksheets(baseSheet).range("AP22").Offset(f, 0).Resize(27, 1).Copy
            Worksheets(nameSheet).range("A1:A27").PasteSpecial xlPasteValues
            Worksheets(baseSheet).range("AQ22").Offset(f, 0).Resize(27, 1).Copy
            Worksheets(nameSheet).range("B1:B27").PasteSpecial xlPasteValues
        Else
            Sheets.Add(After:=Sheets("actSheet")).Name = nameSheet
            Worksheets(baseSheet).range("AP22").Offset(f, 0).Resize(27, 1).Copy
            Worksheets(nameSheet).range("A1:A27").PasteSpecial xlPasteValues
            Worksheets(baseSheet).range("AQ22").Offset(f, 0).Resize(27, 1).Copy
            Worksheets(nameSheet).range("B1:B27").PasteSpecial xlPasteValues
        End If

        '%%%%%%%%%%%%%%%%%%%%%%

        Dim lRow As Long
        Dim lCell As String
        Dim foldername As String
    
        lRow = Cells(Rows.Count, 2).End(xlUp).Row
        lCell = "B" & lRow
        foldername = exportFolder & "\" & nameSheet & ".txt"

        Worksheets(nameSheet).range("A1:" & lCell).SaveAs Filename:=foldername, FileFormat:=xlText, CreateBackup:=False

        Sheets(nameSheet).Activate
        i = i + 30
        f = f + 1
    Loop

    'Call wg_test
End Sub

标签: excelvbaruntime-error

解决方案


通过激活首选工作表然后保存活动工作簿解决了该问题。添加了这些行:

Worksheets(nameSheet).Activate
ActiveWorkbook.SaveAs Filename:=foldername, FileFormat:=xlText, CreateBackup:=False

推荐阅读