Dateien zusammen-Verknüpfungen löschen und anderes
22.03.2018 18:29:10
Jochen
Ein kleines Problem beschäftigt mich seit geraumer Zeit:
Mit dem Code
Public Sub Zusammenfuehren()
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
WBZ.Worksheets(1).Range("A2:IV65536").ClearContents
varDateien = Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte _
Datei(en) markieren", False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
WBQ.Worksheets(1).Range("A4:Z" & lngLastQ).Copy Destination:=WBZ.Worksheets(1).Range("A" _
_
_
_
_
& WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + 1)
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr & "Fehlernummer: " & Err.Number & vbCr & " _
Fehlerbeschreibung: " & Err.Description
End If
End Sub
führe ich beliebig viele Dateien in einer Einzigen zusammen, um diese dann mit Pivot auszuwerten.
Funktioniert auch alles bestens, nur die Verknüpfungen, die in diesen zu zusammenführenden Dateien enthalten sind, hätte ich vorher gerne entfernt, ohne die Dateien zu öffnen.
Hat da irgendwer eine Idee?
Und ein zweites Problem:
Ich erstelle mit meinem Makro-Rekorder eine Pivot-Tabelle. Will ich dann das Makro ausführen, kommen viele Fehlermeldungen.
Hier der Code:
Sub Makro1()
Range("A1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Rohdaten!R1C1:R144C3", Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="Pivot!R1C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion10
Sheets("Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = True
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = True
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = True
.CalculatedMembersInFilters = False
.RowAxisLayout xlTabularRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Artikelbezeichnung")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Artikelbezeichnung"), _
"Anzahl von Artikelbezeichnung", xlCount
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Bestell-Menge"), "Summe von Bestell-Menge", xlSum
With ActiveSheet.PivotTables("PivotTable1").DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
End Sub
Moniert werden hier jeweils die Zeilen, die mit .Display beginnen. Komisch, ich erstelle das Makro mit dem Rekorder, und dann funktioniert es nicht (:-
Ein drittes und sehr kleines Problem:
Ich erstelle am Schluss ein Pivot-Chart. Wie kann ich das denn per VBA in einen bestimmten Ordner, sagen wir mal D:\Daten\asdf als jpg speichern?
Viele Fragen auf einmal, ich weiß. Aber vielleicht weiß der eine oder andere von Euch Rat?
Vielen Dank jedenfalls und einen super schönen Abend wünscht Euch
Jochen
Anzeige