|
Hallo zusammen,
ich habe folgendes Problem und kenne mich jedoch mit VBA nicht so gut aus. Habe sehr viel Code aus dem Internet, da diese Thema bereits div. Male diskutiert wurde. Ich möchte aus einer Datei "wbDatei1" das Makro starten. Aus diesem kann ich ein anderes Excel-File öffnen, worin die Spalten gemäss Array-Definition
neu angeordnet werden sollten. Die übrigen Spalten sollten gelöscht werden.
Im weiteren wird die geöffnete Datei formiert. Der Teil der Formatierung sollte meines Wissens korrekt sein.
Ich habe das Problem, dass die gesuchten Texte in der Datei "wbDatei1" erscheinen und nicht wie gewünscht
in der geöffneten Datei angeordnet werden.
Public Sub CommandButtonTest_Click()
Dim WbDatei1 As String
Dim strFilter As String
Dim strFileName As Variant
Dim Pfad As String
Dim wb As Workbook
Dim ws As Worksheet
Dim strSearch As Variant
Dim intColumn As Integer
Dim bytCounter As Byte
Dim rngGefunden As Range
WbDatei1 = ActiveWorkbook.Name
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
Pfad = "\\XXXXXXX\" ' muss noch angegeben werden
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xls*), *.xls*"
'** Den im Dialogfeld gewählten Namen auslesen
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.InitialFileName = Pfad & Year(Now()) & "\offen Posten zur Zahlung\"
If fd.Show <> -1 Then
Exit Sub
End If
strFileName = fd.SelectedItems(1)
Set ws = Workbooks.Open(strFileName).Sheets("Format")
ws.Activate
Application.ScreenUpdating = False
Sheets("Format").Select
strSearch = Array("Betrag", "Tariftyp", "Steuerkennzeichen", "MwSt.-Nr.", "Abrechnungsdatum", "Druckbelegnummer", _
"Adresse Partner", "Name Partner", "Vertragskonto", "Geschäftspartner") ' Die einzelnen Spalten werden in umgekehrter Reihenfolge in ein Array geschrieben
For bytCounter = LBound(strSearch) To UBound(strSearch)
Set rngGefunden = Rows("1:1").Find(What:=strSearch(bytCounter), _
After:=Cells(1, Columns.Count), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rngGefunden Is Nothing Then
If rngGefunden.Columns <> bytCounter + 1 Then
Columns(rngGefunden.Columns).Cut
Columns(bytCounter + 1).Insert Shift:=xlToRight
End If
Else
Columns(bytCounter + 1).Insert Shift:=xlToRight
Cells(1, bytCounter + 1) = strSearch(bytCounter)
End If
Next bytCounter
Application.CutCopyMode = False
ActiveSheet.Columns("K:Z").Delete 'restliche Spalten löschen
'Seite einrichten
With ActiveSheet.PageSetup 'Seite einrichten
preLayout = .Orientation
preZoom = .Zoom
.Orientation = xlLandscape 'Querformat
.FitToPagesWide = 1 '1 Seite breit
.FitToPagesTall = False '"leer" hoch
.PrintTitleRows = "$1:$1" ' Wiederholungszeilen oben
End With
Columns("A:J").EntireColumn.AutoFit 'Spaltenbreite automatisch anpassen
Application.ScreenUpdating = True
End Sub
Vielen Dank für eure rasche Hilfe
Gruss
Andreas
|