Excel-VBA: Wie zu kopieren gesamten Bereich einschließlich der ausgeblendeten Spalten
Ich bin auf der Suche nach einem VBA-Makro, um Daten zu exportieren, um eine csv-Datei. Ich fand dieser code
die nach einigen Optimierungen macht einen guten job. Jedoch, beim kopieren aus einem Bereich, Excel scheint zu ignorieren, versteckte Spalten, während ich will, dass die CSV, um alle Spalten enthalten. Hat jemand entdeckt, prägnant, code dies?
Hier ist der code, den ich bisher:
Sub ExportListOrTable(Optional newBook As Boolean, Optional willNameSheet As Boolean, Optional asCSV As Boolean, Optional visibleOnly As Boolean)
'Sub CopyListOrTable2NewWorksheet()
'Works in Excel 2003 and Excel 2007. Only copies visible data.
'code source: https://msdn.microsoft.com/en-us/library/dd637097%28v=office.11%29.aspx
'improved by: Tzvi
' - replaced new worksheet with new workbook
'params:
' newBook: To create a new new sheet in the current workbook or (default) in a new workbook
' willNameSheet: To offer the user to name the sheet or (default) leave the default names
' asCSV: not implemented - will always save as CSV
' visibleOnly: to filter out any hidden columns - default false
'TODO
' -add parameter list for following options:
' - if table was not selected, copy activesheet.usedRange
' - optional saveFileType
' -
Dim New_Ws As Worksheet
Dim ACell, Data As Range
Dim CCount As Long
Dim ActiveCellInTable As Boolean
Dim CopyFormats, retrySave As Variant
Dim sheetName, user, defaultFileName, fileSaveName As String
Dim userChoice As Boolean
'Check to see if the worksheet or workbook is protected. TODO this may not be necessary anymore
If ActiveWorkbook.ProtectStructure = True Or ActiveSheet.ProtectContents = True Then
MsgBox "This macro will not work when the workbook or worksheet is write-protected."
Exit Sub
End If
'Set a reference to the ActiveCell. You can always use ACell to
'point to this cell, no matter where you are in the workbook.
Set ACell = activeCell
'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
'do not need to know the name of the table to work with it.
On Error Resume Next
ActiveCellInTable = (ACell.ListObject.Name <> "")
On Error GoTo 0
'TODO here we will select the fields to export
'If the cell is in a list or table run the code.
If ActiveCellInTable = True Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If visibleOnly = True Then
'Test if there are more than 8192 separate areas. Excel only supports
'a maximum of 8,192 non-contiguous areas through VBA macros and manual.
On Error Resume Next
With ACell.ListObject.ListColumns(1).Range 'TODO remove this "with"
CCount = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
End With
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 individual areas, so it is not possible to " & _
"copy the visible data to a new worksheet. Tip: Sort your " & _
"data before you apply the filter and try this macro again.", _
vbOKOnly, "Copy to new worksheet"
Exit Sub
Else
'Copy the visible cells.
ACell.ListObject.Range.Copy
End If
Else
'The user indicated he wants to copy hidden columns too.
'**********************************************************
'HOW DO I PROPERLY IMPLEMENT THIS PART?
'**********************************************************
MsgBox ("You wanted to copy hidden columns too?")
ActiveSheet.UsedRange.Copy
End If
Else
' MsgBox "Select a cell in your list or table before you run the macro.", _
' vbOKOnly, "Copy to new worksheet"
userChoice = MsgBox("A Table/Table protion is not selected. Do you want to export the entire page?", vbYesNo)
If userChoice = False Then Exit Sub
ActiveSheet.UsedRange.Copy
'Exit Sub
End If
'Add a new Worksheet/WorkBook.
If newBook = False Then
Set New_Ws = Worksheets.Add(after:=Sheets(ActiveSheet.Index))
Else
Set New_Ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
End If
'Prompt the user for the worksheet name.
If willNameSheet = True Then
sheetName = InputBox("What is the name of the new worksheet?", _
"Name the New Sheet")
On Error Resume Next
New_Ws.Name = sheetName
If Err.Number > 0 Then
MsgBox "Change the name of sheet : " & New_Ws.Name & _
" manually after the macro is ready. The sheet name" & _
" you typed in already exists or you use characters" & _
" that are not allowed in a sheet name."
Err.Clear
End If
On Error GoTo 0
End If
'Paste the data into the new worksheet.
With New_Ws.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValuesAndNumberFormats
.Select
Application.CutCopyMode = False
End With
Application.ScreenUpdating = False
'If you did not create a table, you have the option to copy the formats.
If ActiveCellInTable = False Then
Application.Goto ACell
CopyFormats = MsgBox("Do you also want to copy the Formatting?", _
vbOKCancel + vbExclamation, "Copy to new worksheet")
If CopyFormats = vbOK Then
ACell.ListObject.Range.Copy
With New_Ws.Range("A1")
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
End If
'Select the new worksheet if it is not active.
Application.Goto New_Ws.Range("A1")
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Now we're ready to save our new file as excel format
defaultFileName = ActiveWorkbook.Name
user = Environ("userprofile")
'marker getfilename: to return to if we need to look for a new filename
getfilename:
ChDir user & "\Desktop"
fileSaveName = Application.GetSaveAsFilename(defaultFileName & ".csv", "Comma Delimited Format (*.csv), *.csv")
If fileSaveName <> "False" Then
'error handling for 'file already exists and the user clicks 'no'
On Error Resume Next
ActiveWorkbook.SaveAs fileName:=fileSaveName, FileFormat:=xlCSV, ReadOnlyRecommended:=True, CreateBackup:=False, ConflictResolution:=xlUserResolution
If Err.Number = 1004 Then
'Offer user two options: To try a different filename or cancel the entire export
retrySave = MsgBox(Err.Description, vbRetryCancel, "Error creating file")
If retrySave = vbRetry Then
GoTo getfilename
Else
GoTo cancelprocedure
End If
End If
On Error GoTo 0
Else
GoTo cancelprocedure
End If
Exit Sub
cancelprocedure:
ActiveWorkbook.Close saveChanges:=False
Exit Sub
End Sub
Update:
In der Antwort zu shagans Sorge. Die parameter-Liste in einer Zeile soll festgelegt werden, durch ein anderes Makro als solches:
Sub ExportVisibleAsCSV
Call ExportListOrTable(newBook:=True, willNameSheet:=False, asCSV:=True, visibleOnly:=True)
End Sub
Du musst angemeldet sein, um einen Kommentar abzugeben.
Aktualisierung nun, dass Beispiel-code verfügbar ist:
Ok-Blick auf den code, den Sie geschrieben, sehe ich ein bool namens visibleOnly aber ich sehe nicht, wo es festgelegt wird. Ihre Fähigkeit, die Logik zu erreichen UsedRange.Kopie ganz, hängt davon ab, dass auf false gesetzt. Der Kommentar oben ACell.ListObject.Bereich.Kopieren Sie zeigt, dass, wenn Sie erreichen, dass die Aussage, die Sie nur kopieren sichtbare Zellen. Um zu kopieren die ausgeblendeten Zellen, visibleOnly müsste auf false gesetzt werden (unter Umgehung der rest des Kontos Zeug). Also ich wäre daran interessiert zu wissen, wie das bool-setzen und überprüfen, um zu sehen, was sein Wert ist eingestellt, wenn Sie mit Ihrem code.
Update 2:
Müssen Sie den Wert Ihrer visibleOnly boolean irgendwie.
hier ist etwas code, den ich redigiert, erstellt eine message-box, die dem Benutzer ermöglicht, zu sagen, "ja" oder "Nein" "möchten Sie eine Kopie der versteckten Daten auch?", die Antwort wird diktieren, den Wert von visibleOnly die wiederum bestimmt, welche Strömung Sie enter.
Zusätzlich zu, dass Ihre Annahme, dass ACell.ListObject.Bereich.Kopieren würde nur kopieren sichtbare Zellen zu haben scheint, falsch war. Statt, der ersetzt wird mit der specialcell Typ für sichtbare Zellen.
Schließlich, vbYesNo nicht wirklich einen booleschen Wert zurückgeben. Stattdessen gibt es zurück vbYes oder vbNo die vb-Typ-Zähler (Wert 6 und 7 beziehungsweise). Also Einstellung ein boolescher Wert, der den Wert einer vbYesNo wird immer True zurück (als ein Wert vorhanden ist und im wesentlichen nur ausgewertet, WENNFEHLER).
So geändert habe, dass etwas als gut, so dass es nun korrekt überprüft, die ja/Nein-Bedingung, die auf Ihrem userchoice (das ist nicht mehr bool).
hier der code:
visibleOnly == false
. Bat ich um Hilfe bei der Umsetzung die richtige Methode, dies zu erreichen. Hinweis: die anormalenMsgBox
es undActiveSheet.UsedRange.Copy
beschränkt sich nicht auf die Tabelle und werden auch in ausgeblendeten Spalten. Ich werde den code Bearbeiten oben zu klären.Weisen Sie den Wert der Reihe, um Ihr Ziel-Bereich statt mit dem .Copy-Methode:
Dies hat auch den Vorteil, dass es nicht nuking, was der Benutzer haben könnte, auf die Zwischenablage.