Excel VBA - Workbook öffnen und bearbeiten in Schleife einbauen.

jerry0110

Erfahrenes Mitglied
So nachdem ich jetzt 2 Fragen selber beantworten konnte, stehe ich jetzt auf dem Schlauch.

Ich habe jetzt meine Exporte als CSV gespeichert und diese werden durch einen Loop in Excel umgewandelt.
Jetzt möchte ich diese Datei die gerade umgewandelt wurde öffnen und dann formatieren.

Hier noch mal der Code für die Umwandlung in Excel:

Visual Basic:
Option Explicit

Private Function xlsGetLastRow(ByRef sheet As Object) As Long
  Const xlCellTypeLastCell = 11
  'Zur letzten initialisierten Zeile gehen
  xlsGetLastRow = sheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  
  'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
  Do While sheet.Application.WorksheetFunction.CountA(sheet.Rows(xlsGetLastRow)) = 0 And xlsGetLastRow > 1
  xlsGetLastRow = xlsGetLastRow - 1
  Loop
End Function

Private Function lastRowNr(ByRef ws As Worksheet)

  lastRowNr = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
  
End Function

Public Function xlsGetLastColumn(ByRef sheet As Object) As Long
  Const xlCellTypeLastCell = 11
  'Zur letzten initialisierten Zeile gehen
  xlsGetLastColumn = sheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  
  'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
  Do While sheet.Application.WorksheetFunction.CountA(sheet.Columns(xlsGetLastColumn)) = 0 And xlsGetLastColumn > 1
  xlsGetLastColumn = xlsGetLastColumn - 1
  Loop
End Function

Private Function datum() As Date
  If Weekday(Date, vbMonday) = 1 Then
  datum = Date - 3
  Else
  datum = Date - 1
  End If
End Function

Sub CSV_Woechentlich_erstellen()

Dim source As Worksheet
Dim LastRowNrSource As Long
Dim f

Set source = ThisWorkbook.Worksheets("Tabelle1")

'letzte Ziele im Ziel berechnen
LastRowNrSource = lastRowNr(source)
  
  For f = lastRowNr(source) To 1 Step -1
  If source.Range("E" & f) = "1x pro Woche" Then
  Dim sFile As String, sPath As String, iFree As Integer
  Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
  Dim zFile As String
  
  sPath = source.Range("B2") & source.Range("G" & f) 'anpassen
  sFile = Dir(sPath & "*.csv")
  zFile = "Report"
  Application.ScreenUpdating = False
  
  Do While Len(sFile)
  
  iFree = FreeFile
  Open sPath & sFile For Input As iFree
  arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
  Close iFree
  
  For i = 0 To UBound(arrCSV)
  arrTmp = Split(arrCSV(i), ";")
  n = Application.Max(n, UBound(arrTmp))
  Next
  
  ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
  For i = 0 To UBound(arrCSV)
  arrTmp = Split(arrCSV(i), ";")
  
  For j = 0 To UBound(arrTmp)
  arrXLS(i + 1, j + 1) = arrTmp(j)
  Next
  Next
  
  With Workbooks.Add
  .Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
  .SaveAs sPath & Mid(zFile, 1, Len(sFile) - 4)
  .Close
  End With
  
  sFile = Dir
  Loop
  
  LastRowNrSource = LastRowNrSource + 1
  End If
  Next f
  
End Sub

Das formatieren habe ich schon fertig. Nur bekomme ich das Öffnen der Datei einfach nicht hin.

Und danach soll dann entsprechend eine Email mit dem formatierten Anhang verschickt werden.
 

jerry0110

Erfahrenes Mitglied
So eine Nacht drüber geschlafen. Habe es jetzt hinbekommen, in der Schleife die gerade gespeicherte Datei wieder zu öffnen.
Nur wie kann ich jetzt das Tabellenblatt formartieren?

Visual Basic:
With Workbooks.Add
  .Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
  .SaveAs sPath & Mid(zFile, 1, Len(sFile) - 4)
  .Close
  End With

Workbooks.Open (source.Range("B2") & source.Range("G" & f) & "Report.xlsx")
Workbooks("Report.xlsx").Activate
Workbooks("Report.xlsx").Close SaveChanges:=True


Und hiermit soll das Tabellenblatt formartiert werden:

Visual Basic:
.Orientation = xlLandscape
  .PaperSize = xlPaperA4
  .PrintArea = "A" & f & ":AK" & f
  .FitToPagesWide = 1
  .FitToPagesTall = 1
  .Zoom = 43
  .LeftMargin = Application.CentimetersToPoints(0.5)
  .RightMargin = Application.CentimetersToPoints(0.5)
  .HeaderMargin = Application.CentimetersToPoints(0)
  .TopMargin = Application.CentimetersToPoints(0)
  .FooterMargin = Application.CentimetersToPoints(0.3)
  .BottomMargin = Application.CentimetersToPoints(0.3)
  .CenterFooter = "Report"
  .RightFooter = Format(Date, "DD.MM.YYYY")

und

Visual Basic:
Columns("A:A").ColumnWidth = 10.8
Columns("B:B").ColumnWidth = 12
Columns("C:C").ColumnWidth = 12.6
Columns("D:D").ColumnWidth = 15
Columns("E:E").ColumnWidth = 16
Columns("F:F").ColumnWidth = 14
Columns("G:G").ColumnWidth = 13
Columns("H:H").ColumnWidth = 16
Columns("I:I").ColumnWidth = 16
Columns("J:J").ColumnWidth = 9.4
Columns("K:K").ColumnWidth = 6.4
Columns("L:L").ColumnWidth = 24
Columns("M:M").ColumnWidth = 55
Columns("N:N").ColumnWidth = 11.33
Columns("O:P").ColumnWidth = 55
Columns("Q:Q").ColumnWidth = 17
Columns("R:T").ColumnWidth = 12
Rows("1:2000").AutoFit
 

jerry0110

Erfahrenes Mitglied
Habe es glaub ich gelöst :)

Visual Basic:
Workbooks.Open (source.Range("B2") & source.Range("G" & f) & Format(source.Range("E1"), "YYYYMMDD") & "_" & Format(source.Range("G1"), "YYYYMMDD") & source.Range("I" & f))
         Workbooks(Format(source.Range("E1"), "YYYYMMDD") & "_" & Format(source.Range("G1"), "YYYYMMDD") & source.Range("I" & f)).Activate
         With Worksheets("Tabelle1").PageSetup
            .Orientation = xlLandscape
            .PaperSize = xlPaperA4
            .PrintArea = "A" & f & ":T" & f
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            .Zoom = 43
            .LeftMargin = Application.CentimetersToPoints(0.5)
            .RightMargin = Application.CentimetersToPoints(0.5)
            .HeaderMargin = Application.CentimetersToPoints(0)
            .TopMargin = Application.CentimetersToPoints(0)
            .FooterMargin = Application.CentimetersToPoints(0.3)
            .BottomMargin = Application.CentimetersToPoints(0.3)
            .CenterFooter = "opta data dialog"
            .RightFooter = Format(Date, "DD.MM.YYYY")
         End With
         With Worksheets("Tabelle1")
            .Columns("A:A").ColumnWidth = 10.8
            .Columns("B:B").ColumnWidth = 12
            .Columns("C:C").ColumnWidth = 12.6
            .Columns("D:D").ColumnWidth = 15
            .Columns("E:E").ColumnWidth = 16
            .Columns("F:F").ColumnWidth = 14
            .Columns("G:G").ColumnWidth = 13
            .Columns("H:H").ColumnWidth = 16
            .Columns("I:I").ColumnWidth = 16
            .Columns("J:J").ColumnWidth = 9.4
            .Columns("K:K").ColumnWidth = 6.4
            .Columns("L:L").ColumnWidth = 24
            .Columns("M:M").ColumnWidth = 55
            .Columns("N:N").ColumnWidth = 11.33
            .Columns("O:P").ColumnWidth = 55
            .Columns("Q:Q").ColumnWidth = 17
            .Columns("R:T").ColumnWidth = 12
            .Rows("1:2000").AutoFit
        End With
         Workbooks(Format(source.Range("E1"), "YYYYMMDD") & "_" & Format(source.Range("G1"), "YYYYMMDD") & source.Range("I" & f)).Close SaveChanges:=True
 

Neue Beiträge