[英]VBA Export Excel to CSV with Range
我使用了在這里找到的代碼。
經過一些更改后,這就是我現在擁有的代碼:
Option Explicit
Sub ExportAsCSV()
Dim MyFileName As String
Dim Item As String
Dim Path As String
Dim CurrentWB As Workbook, TempWB As Workbook
Path = "F:\Excels\csv export\"
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("Nieuw Artikelnummer").UsedRange.Copy
Item = Range("D2")
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("csv").UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
MyFileName = Path & "\" & Item & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
MsgBox ".csv file has been created: " _
& vbCrLf _
& MyFileName
End Sub
我的問題是它使用UsedRange,但是我想選擇復制到新.csv文件中的Range。
如何選擇要復制到新文件中的Range而不是UsedRange?
這將在商品編號表上打開一個輸入框,您可以手動選擇或輸入范圍:
Sub ExportAsCSV()
Dim MyFileName As String
Dim Item As String
Dim Path As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim myrangeNA As Range
Dim myRangeCSV As Range
Path = "F:\Excels\csv export\"
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("Nieuw Artikelnummer").Activate
Set myrangeNA = Application.InputBox(prompt:="Select a range to copy", Type:=8)
Item = Range("D2")
Set TempWB = Application.Workbooks.Add(1)
myrangeNA.Copy Destination:=TempWB.Worksheets("Sheet1").Range("A1")
MyFileName = Path & "\" & Item & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
MsgBox ".csv file has been created: " _
& vbCrLf _
& MyFileName
End Sub
如果您不想選擇它,請將myrangeNA
更改為myrangeNA
的任何范圍,例如range("A5:C20")
,它應該可以工作。
對於這種情況,我更喜歡將動作隔離到可以使用參數調用的獨立Sub
或Function
。 這樣,我可以根據需要在項目或另一個項目中重復使用它。
因此,我將復制所選數據范圍並粘貼到臨時工作簿,然后在其自己的Function
保存到CSV文件的操作分開了。 該操作將返回True / False結果作為成功檢查的結果。
Option Explicit
Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Dim destCSVfile As String
destCSVfile = "C:\Temp\" & ws.Range("D2")
If ExportAsCSV(Selection, destCSVfile) Then
MsgBox ".csv file has been created: " _
& vbCrLf _
& destCSVfile
Else
MsgBox ".csv file NOT created"
End If
End Sub
Private Function ExportAsCSV(ByRef dataArea As Range, _
ByVal myFileName As String) As Boolean
'--- make sure we have a range to export...
ExportAsCSV = False
If dataArea Is Nothing Then
Exit Function
End If
dataArea.Copy
'--- create a temporary workbook that will be saved as a CSV format
Dim tempWB As Workbook
Set tempWB = Application.Workbooks.Add(1)
With tempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'--- suppress alerts to convert the temp book to CSV
Application.DisplayAlerts = False
tempWB.SaveAs filename:=myFileName, FileFormat:=xlCSV, _
CreateBackup:=False, Local:=True
tempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
ExportAsCSV = True
End Function
上面注釋中的其他兩個問題提到粘貼轉置值,您可以通過將myrangeNA.Copy Destination:=TempWB.Worksheets("Sheet1").Range("A1")
行更改為粘貼值來完成
myrangeNA.Copy
TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
該網站是Office VBA集合中所有各種對象,方法和屬性的很好的參考源: https : //docs.microsoft.com/zh-cn/office/vba/api/overview/excel/object-model (或https://docs.microsoft.com/de-de/office/vba/api/overview/excel/object-model(如果您希望將大約五個單詞翻譯成德語)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.