Einlesen des Dateinamens in Makro
27.01.2004 13:59:44
Clemens
ich habe hier folgendes Problem.
Der nachfolgende Code funktioniert einwandfrei bis auf den
Rücksprung von der geöffneten Datei "Bezeichnungen.xls"
zur vorherigen Datei "Jan_bis_Okt_2003 Version 2004.xls".
d.h.
ich öffne zuerst die Datei "Jan_bis_Okt_2003 Version 2004.xls"
und starte darin das in der "Persönlich.xls" hinterlegte Makro.
Das Makro formatiert daraufhin meine geöffnete Datei "Jan_bis_Okt_2003 Version 2004.xls" und soll dann noch die Datei "Bezeichnungen.xls" öffnen,
wieder zurück in die Datei "Jan_bis_Okt_2003 Version 2004.xls" springen
und dort meine Formel eintragen sowie die Datei fertigformatieren.
(Die Datei "Bezeichnungen.xls" will ich vorher öffnen, damit die Berechnung
nicht so lange dauert.)
Hier ein Auszug aus dem Code:
'Bezeichnung öffnen
Workbooks.Open Filename:= _
"O:\GRUPPEN\Abt-1-2\SONSTIGE\Plus\Bezeichnungen.xls"
Sheets("Hauptabteilungen").Select
Windows("Jan_bis_Okt_2003 Version 2004.xls"). _
Activate
Range("B20").Select
Wie könnte man hier die vorherige Datei als Variable zuweisen ??
Windows("Jan_bis_Okt_2003 Version 2004.xls"). _
Activate
Dies funktioniert auch soweit
jedoch muß ich noch den Dateiname "Jan_bis_Okt_2003 Version 2004.xls"
im Code hinterlegt lassen.
Es gibt mehrere Dateien die den gleichen Aufbau haben wie die "Jan_bis_Okt_2003 Version 2004.xls" und somit würde ich gerne dass der Dateiname eingelesen wird
und über den vorab eingelesenen Dateiname weiß wohin er zurückspringen soll.
Sub Makro_PLUS()
' Makro_PLUS Makro
' Tastenkombination: Strg+e
'Hinweise auf Tabellenblatt nach rechts verschieben
Range("F4:K6").Select
Selection.Cut Destination:=Range("Y4:AD6")
Range("Y4:AD6").Select
ActiveWindow.SmallScroll ToRight:=-12
Range("A4:D6").Select
Selection.Cut Destination:=Range("T4:W6")
Range("T4:W6").Select
ActiveWindow.SmallScroll ToRight:=-14
'Spalten ausblenden
Columns("E:H").Select
Selection.EntireColumn.Hidden = True
Columns("M:P").Select
Selection.EntireColumn.Hidden = True
'Bei Spalte B eine neue Spalte einfügen.Hier kommt später der Text rein
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
'Druckbereich einrichten
Range("A1:Y806").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$Y$806"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "Seite: &P; &D"
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 70
.PrintErrors = xlPrintErrorsDisplayed
End With
'ActiveWindow.SelectedSheets.PrintPreview
Columns("M:M").ColumnWidth = 11.29
Range("A1").Select
ActiveWindow.View = xlNormalView
'Wiederholzeilen einrichten
With ActiveSheet.PageSetup
.PrintTitleRows = "$17:$19"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$Y$806"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "Seite: &P; &D"
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 70
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.View = xlNormalView
'Bezeichnung öffnen
Workbooks.Open Filename:= _
"O:\GRUPPEN\Abt-1-2\SONSTIGE\Plus\Bezeichnungen.xls"
Sheets("Hauptabteilungen").Select
Windows("Jan_bis_Okt_2003 Version 2004.xls"). _
Activate
Range("B20").Select
'Einfügen der Berechnungsformel und ausfüllen der Berechnungsspalte
'Spaltenbezeichnung und Spaltenbreite festlegen
'Druckansicht heruntersetzen
Range("B20").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-1],'O:\GRUPPEN\Abt-1-2\SONSTIGE\Plus\Bezeichnungen.xls'!Katalog_04,3,FALSE)),"""",VLOOKUP(RC[-1],'O:\GRUPPEN\Abt-1-2\SONSTIGE\Plus\Bezeichnungen.xls'!Katalog_04,3,FALSE))"
Range("B20").Select
Selection.Copy
Range("B20:B803").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B18").Select
ActiveCell.FormulaR1C1 = "Bezeichnung"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Times New Roman"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C18").Select
Selection.Copy
Range("B18").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Columns("B:B").Select
Range("B2").Activate
'Selection.ColumnWidth = 25
Selection.ColumnWidth = 50
Range("B18").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "Seite: &P; &D"
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 60
.PrintErrors = xlPrintErrorsDisplayed
End With
'ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.View = xlNormalView
Range("A2").Select
'Bezeichnungen schließen
Windows("Bezeichnungen.xls").Activate
ActiveWorkbook.Close
Range("A1").Select
'Hinweise auf Tabellenblatt wieder nach links verschieben
Range("U4:X6").Select
Selection.Cut Destination:=Range("A4:D6")
Range("Z4:AE6").Select
Selection.Cut Destination:=Range("R4:W6")
Range("A1").Select
End Sub
Hat jemand eine Idee ?
Vielen Dank für das Interesse.
Clemens