Provi gesuch der helfen kann
07.12.2007 18:17:00
Wild
Mein erstes Problem:
Ich habe da eine Tabelle auf der ich ca. 30 Command Button's habe die mir jeweils eine ganz bestimmte Arbeitsmappe öffnen. Diese Mappe wird dann hinter der offenen Tabelle gehallten.
Das dumme daran ist das zwar alle Arbeitsmappen in verschiedenen Ordnern untergebracht sind aber schlussendlich alle den gleichen Namen tragen. Nämlich "Daten". Nun das wäre nicht schlimm, denn es darf sowiso immer nur eine Datenmappe offen sein. Wenn ich nun aber abgelenkt werde und aus Versehen noch einmal einen Button drücke bringt mir Excel logischerweise eine Meldung das 2 Mappen mit demselben Namen geöffnet werden sollen und das geht ja nicht.
Ich bräuchte nun einen Code der mir nach dem drücken eines Button's zuerst prüft ob eine Mappe Namens "Daten" bereits geöffnet ist oder nicht. Ist bereits eine Mappe offen so soll auf eine Userform verwiesen werden mit der ich abbrechen kann. Die Userform habe ich bereits kreiert. Ist keine Mappe Namens "Daten"offen so kann normal weiterverfahren werden.
Hier der Cod der hinter dem Button hinterlegt ist.
Workbooks.Open Filename:= _
"C:\Dokumente und Einstellungen\Rolf u.Sonya\Eigene Dateien\VBZ\VBZ 2007\9101\Daten\Daten.xls"
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("01").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", _
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25")).Select
Sheets("01").Activate
Sheets(Array("26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", _
"39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50")).Select Replace _
:=False
Sheets(Array("51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", _
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75")).Select Replace _
:=False
Sheets(Array("76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", _
"89", "90", "91")).Select Replace:=False
Cells.Select
Selection.Rows.AutoFit
Range("A1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12", "13", _
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25")).Select
Sheets("01").Activate
Sheets(Array("26", "27", "28", "29", "30", "31", "32", "33", "34", "35", "36", "37", "38", _
"39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50")).Select Replace _
:=False
Sheets(Array("51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", _
"64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75")).Select Replace _
:=False
Sheets(Array("76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", _
"89", "90", "91")).Select Replace:=False
Sheets("01").Select
ActiveWorkbook.Save
Windows("Drucken.xls").Activate
End Sub
Wobei Drucken.xls die Tabelle ist auf der die Button's anzutreffen sind.
Mein zweites Problem:
Auf eben dieser Tabelle Namens Drucken existieren noch 135 weitere Button's die mir jeweils eine ganz bestimmte Tabelle aus der Mappe Daten auswählen, zum Drucken vorbereiten und dann auf eine weitere Userform verweisen.
Ist hier nun keine Mappe "Daten" offen so kommt unweigerlich die Meldung zum Debuggen.
Hier bräuchte ich ebenfalls einen Code der mir prüft ob die Mappe Daten offen ist oder nicht.
Ist sie offen so kann der Code weiter abgearbeitet werden. Ist sie nicht offen so soll wieder auf meine Userform verwiesen werden damit ich abbrechen kann.
Hier noch ein Code der das Drucken vorbereitet.
Sub Makro6020()
Windows("Daten.XLS").Activate
Range("A1:V34").Select
Sheets("20").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.275590551181102)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.275590551181102)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.078740157480315)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = True
.PrintNotes = False
'.Druckqualität = 300
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 80
frmDruckmenü.Show
End With
Windows("Drucken.XLS").Activate
End Sub
Vielen herzlichen Dank für eure Bemühungen schon im voraus
MfG Wild Rolf