VBA Menü Ein-/ Ausblendung bei Datenexport
26.09.2013 11:32:37
Gregy
vorerst, ich nutze Excel 2010 und erstelle gerade eine Kalkulationsbasis. Ich habe über VBA ein _ Modul programmiert mit folgendem Quellcode:
Sub User()
Application.ScreenUpdating = False
If Application.DisplayStatusBar = True Then
For n = 1 To 2
Application.CommandBars("Worksheet Menu Bar").Enabled = False
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
Application.DisplayFullScreen = True
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
ActiveWindow.DisplayWorkbookTabs = False
Next
Else
For n = 1 To 2
Application.CommandBars("Worksheet Menu Bar").Enabled = True
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
Application.DisplayFullScreen = False
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
ActiveWindow.DisplayWorkbookTabs = True
Next
End If
Application.ScreenUpdating = True
End Sub
und ich kann über mein erstelltes Menü in der Mappe rumfrickeln wir ich lustig bin.
Problem 1:
Wenn ich nun meine Exceldatei über das Kreutz schließe und meine Tabelle erneut öffne wird das Menüband wieder einbeblendet (ich habe mir bisher geholfen indem ich ein "Excel-Schließen- Button" erstellt habe wo ich, bevor Excel geschlossen wird, nochmal das oben genannte Script als Sub Workbook_Close ausführe). Auch das Funktioniert, allerdings ist es für den Endanwender fehlerbehaftet. Wie kann ich das anpassen? Google hilft mir leider nicht weiter.
Problem 2:
Ein Tabellenblatt aus dieser Kalkulation muss ich "exportieren" in eine neue Excel-Sitzung. Code hierfür sieht wie folgt aus:
Sub Daten_Übertragen()
Application.ScreenUpdating = False
Dim NewWB As Workbook
ThisWorkbook.Sheets("ALB").Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
ThisWorkbook.Sheets("ALB").Range("A1:Z48").Copy
Set NewWB = Workbooks.Add
With ActiveSheet.Range("A1")
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With
Workbooks(1).Activate
ThisWorkbook.Sheets("ALB").Range("A1:Z48").Copy
Workbooks(2).Activate
With ActiveSheet.Range("A1")
.PasteSpecial Paste:=xlPasteColumnWidths, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial xlPasteComments
End With
'FORMELN KOPIEREN
Workbooks(1).Activate
tmp1 = Cells(11, 16).Formula
Workbooks(2).Activate
Cells(11, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(12, 16).Formula
Workbooks(2).Activate
Cells(12, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(13, 16).Formula
Workbooks(2).Activate
Cells(13, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(14, 16).Formula
Workbooks(2).Activate
Cells(14, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(15, 16).Formula
Workbooks(2).Activate
Cells(15, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(16, 16).Formula
Workbooks(2).Activate
Cells(16, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(17, 16).Formula
Workbooks(2).Activate
Cells(17, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(18, 16).Formula
Workbooks(2).Activate
Cells(18, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(19, 16).Formula
Workbooks(2).Activate
Cells(19, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(20, 16).Formula
Workbooks(2).Activate
Cells(20, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(21, 16).Formula
Workbooks(2).Activate
Cells(21, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(22, 16).Formula
Workbooks(2).Activate
Cells(22, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(23, 16).Formula
Workbooks(2).Activate
Cells(23, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(24, 16).Formula
Workbooks(2).Activate
Cells(24, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(25, 16).Formula
Workbooks(2).Activate
Cells(25, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(26, 16).Formula
Workbooks(2).Activate
Cells(26, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(27, 16).Formula
Workbooks(2).Activate
Cells(27, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(28, 16).Formula
Workbooks(2).Activate
Cells(28, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(29, 16).Formula
Workbooks(2).Activate
Cells(29, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(30, 16).Formula
Workbooks(2).Activate
Cells(30, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(31, 16).Formula
Workbooks(2).Activate
Cells(31, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(32, 16).Formula
Workbooks(2).Activate
Cells(32, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(33, 16).Formula
Workbooks(2).Activate
Cells(33, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(34, 16).Formula
Workbooks(2).Activate
Cells(34, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(35, 16).Formula
Workbooks(2).Activate
Cells(35, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(36, 16).Formula
Workbooks(2).Activate
Cells(36, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(37, 16).Formula
Workbooks(2).Activate
Cells(37, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(38, 16).Formula
Workbooks(2).Activate
Cells(38, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(39, 16).Formula
Workbooks(2).Activate
Cells(39, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(40, 16).Formula
Workbooks(2).Activate
Cells(40, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(41, 16).Formula
Workbooks(2).Activate
Cells(41, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(42, 16).Formula
Workbooks(2).Activate
Cells(42, 16).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 7).Formula
Workbooks(2).Activate
Cells(43, 7).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 11).Formula
Workbooks(2).Activate
Cells(43, 11).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 12).Formula
Workbooks(2).Activate
Cells(43, 12).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 13).Formula
Workbooks(2).Activate
Cells(43, 13).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 14).Formula
Workbooks(2).Activate
Cells(43, 14).Formula = tmp1
Workbooks(1).Activate
tmp1 = Cells(43, 16).Formula
Workbooks(2).Activate
Cells(43, 16).Formula = tmp1
ThisWorkbook.Sheets("ALB").Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Application.CutCopyMode = False
End Sub
Im Zusammenspiel mit dem Ausblenden der gesamten Menüführung habe ich nach der Exportierung kein Menü. Die überführte Arbeitsmappe in einer neuen Excel-Applikation soll allerdings normal ausgeführt werden (als wäre nie das Menüband weg gewesen).
Auch hier die Frage: kann mir hier jemand helfen.
Ich weiß, das ist alles ganz schön viel und bedanke mich deshalb schon im Voraus tausend Mal
Gruß
Gregy