使用VBA将Excel数据导出为CSV不会导出正确的文件类型和单元格值

Question

我有一个Excel文件，它应该具有以下功能：

用户选择一个范围并单击导出按钮，这将生成一个CSV文件，该文件具有包括日期在内的特定标题，如"；annual_25.03.2022"；与Excel文件一样，单元格只包含值，所有单元格都有公式。

playerNr |金额|原因|到期日期|产品类型|产品项

13661748|100|周年纪念|2022-04-19T23:59:00|全部|全部

所有行后面都有公式。我遇到的问题是：

• 前两行playerNr和amount不是作为值导出的，而是作为单元格后面的公式导出的
• 创建的文件没有所需的名称，只是标准格式(新书(
• 创建的文件具有Excel扩展名，而不是CSV
• 导出按钮也在新文件上，即使我没有选择它，我也希望在新文件中删除它，导出按钮应该只在Excel模板上

VBA如下所示：

Sub ExportSelectedData()

ActiveSheet.Unprotect

Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
xTitleId = "Check your selection"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
'Application.ActiveSheet.PasteSpecial Paste:=xlPasteValues
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")
xFileString = Application.GetSaveAsFilename("Anniversaries " & Format(Date, "dd-mm-yyyy"), filefilter:="Comma Separated Text (*.CSV), *.CSV")
Application.ActiveWorkbook.SaveAs FileName:=xFileString, FileFormat:=xlCSV, CreateBackup:=False
ActiveSheet.Protect

End Sub

所以我不知道如何只粘贴值，也不知道为什么新文件的字符串是错误的，我尝试了各种方法，但都不起作用。

此外，我不知道为什么导出按钮仍然保留在新文件上，而图纸保护似乎只是随机工作的。

建议之后，我运行了以下代码：

Sub ExportSelectedData()
Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim ws as Worksheet
Set ws = ActiveSheet
ws.Unprotect
Dim xFileString As StringOn Error Resume Next
xTitleId = "Check your selection"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
For Each sh In ActiveSheet.Shapes: sh.Delete: Next
ActiveSheet.Range("A1").Resize(WorkRng.rows.count, WorkRng.Columns.count).value = WorkRng.value
ws.Protect
Set xFile = CreateObject("Scripting.FileSystemObject")
xFileString = Application.GetSaveAsFilename("Anniversaries " & Format(Date, "dd-mm-yyyy"), filefilter:="Comma Separated Text (*.CSV), *.CSV")
Application.ActiveWorkbook.SaveAs FileName:=xFileString, FileFormat:=xlCSV, CreateBackup:=False
Debug.Print xFileString:Stop

End Sub

调试显示"在immediate窗口中，并没有使用上述内容生成新文件。

Answer 1

请尝试下一个代码，它应该能像(我理解的(你需要的那样工作：

Sub ExportSelectedData()
Dim ws As Worksheet, sh As Worksheet, shP As Shape
Dim WorkRng As Range, xFileString As String, xTitleId As String

Set ws = ActiveSheet: ws.Unprotect
xTitleId = "Please, select the range to place it in the .CSV document!"
Set WorkRng = Application.InputBox("Range", xTitleId, , Type:=8)
ws.Copy 'create a workbook containing the former active sheet
Set sh = ActiveWorkbook.Worksheets(1)
sh.cells.Clear 'clear the content of the newly created workbook, active sheet
For Each shP In ActiveSheet.Shapes: shP.Delete: Next 'delete all existing sheets
'copy the necessary range as value:
sh.Range("A1").Resize(WorkRng.rows.count, WorkRng.Columns.count).value = WorkRng.value
'choose the folder where to save the csv and build its name:
xFileString = GetFolderPath(ThisWorkbook.path)
xFileString = xFileString & Application.PathSeparator & "Anniversaries " & Format(Date, "dd-mm-yyyy") & ".CSV"
Debug.Print xFileString: Stop 'check if the path has been correctly built. If yes, press F5
'save the active document using the above settled name:
ActiveWorkbook.saveas fileName:=xFileString, FileFormat:=xlCSV, local:=False, CreateBackup:=False
'ActiveWorkbook.close False 'uncomment this line after confirmation that it works as you need...
ws.Protect
End Sub

编辑：

对于在MAC上使用代码，请尝试下一个功能，提供选择文件夹并返回其路径的可能性：

Private Function GetFolderPath(Optional strPath As String) As String
Dim Fldr As FileDialog
Dim sItem As String
Set Fldr = Application.FileDialog(msoFileDialogFolderPicker)
With Fldr
.Title = "Select a Folder to build the SaveAs name!"
.AllowMultiSelect = False
If strPath <> "" Then .InitialFileName = strPath 'the folder where the dialog to open
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolderPath = sItem
Set Fldr = Nothing
End Function

它可以通过下一种方式进行测试：

Sub testGetFldPath()
Dim foldPath As String
foldPath = GetFolderPath(ThisWorkbook.path)
foldPath = foldPath & Application.PathSeparator & "Anniversaries " & Format(Date, "dd-mm-yyyy") & ".CSV"
Debug.Print foldPath
End Sub

我将调整初始代码以使用它。