【问题标题】:Export XLS file using cell reference使用单元格引用导出 XLS 文件
【发布时间】:2021-03-21 12:50:34
【问题描述】:

我有以下代码旨在将工作表复制到新位置。

Sub XLSSave()

    Sheets("Group Import").Copy
    Cells.Copy
    Cells.PasteSpecial xlPasteValues
    ActiveWorkbook.SaveAs Filename:=Sheets("Group Import").Range("B22")
    ActiveWorkbook.Close False
 
End Sub

单元格 K67 是一个文件路径,类似于
"C\Folder1\Folder2\Folder3\YYYY\MM\DD"
"C:\Folder1\Folder2\Folder3\YYYY\MM\DD"。
路径“C:”设置正确,我在问题上打错了。

我原本打算只连接单元格 B22 中的地址,因为它需要是动态的。

它正在将 Excel 文件导出为乱码。

【问题讨论】:

  • "C\ ..." 不是文件路径。另外,您使用的是什么语言/字符页面?
  • 抱歉,FileName 设置为具有完整文件名和路径的单元格 - B22 = C\Folder1\Folder2\Folder3\YYYY\MM\DD\FileName.xls。版本是 Excel 365 - 英文版。
  • C\ 仍然不正确!
  • 抱歉。是的,我错过了:,但是它出现在单元格中。

标签: excel vba export copy-paste


【解决方案1】:

导出工作表

简单

Option Explicit

Sub XLSSaveEasy()

    Application.ScreenUpdating = False

    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Group Import")
    sws.Copy

    Dim dws As Worksheet: Set dws = ActiveWorkbook.Worksheets(1)
    dws.UsedRange.Value = dws.UsedRange.Value

    Application.DisplayAlerts = False
    dws.Parent.SaveAs sws.Range("B22").Value, xlOpenXMLWorkbook
    Application.DisplayAlerts = True

    dws.Parent.Close False

    Application.ScreenUpdating = True

End Sub

没那么容易

Sub XLSSave()
    
    Const swsName As String = "Group Import"
    Const swsFilePathCell As String = "B22"
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(swsName)
    
    Dim FilePath As String: FilePath = sws.Range(swsFilePathCell).Value
    Dim FolderPath As String
    FolderPath = Left(FilePath, InStrRev(FilePath, "\") - 1)
    
    If Dir(FolderPath, vbDirectory) <> "" Then
        
        Application.ScreenUpdating = False
        
        sws.Copy
        
        Dim dws As Worksheet: Set dws = ActiveWorkbook.Worksheets(1)
        dws.UsedRange.Value = dws.UsedRange.Value
        
        Application.DisplayAlerts = False
        dws.Parent.SaveAs FilePath, xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        
        dws.Parent.Close False
        
        Application.ScreenUpdating = True

        MsgBox "Backup of worksheet '" & swsName & "' created as '" _
            & FilePath & "'.", vbInformation, "Success"

    Else
        
        MsgBox "The Folder '" & FolderPath & "' does not exist.", _
            vbCritical, "Fail"
    
    End If

End Sub

【讨论】:

  • 太棒了。不得不做一个小的编辑,因为参考是在不同的表上,但很简陋。感谢您的帮助。
【解决方案2】:

首先:对于光盘 C 路径必须从“C:\”开始,在您的情况下:

"C:\Folder1\Folder2\Folder3\YYYY\MM\DD"

第二:您必须将文件保存到已经存在的文件夹,对于您的情况,您必须用“\”分割路径并检查所有子文件夹的存在。

【讨论】:

  • 您好,感谢您的反馈。路径设置正确,我在 SO 问题上打错字了。
猜你喜欢
  • 2016-12-26
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2023-01-13
  • 1970-01-01
相关资源
最近更新 更多