Makros funktionieren nur unter bestimmten Bedingun
06.10.2004 15:09:47
Helmut
Ich habe diesmal 2 Probleme. Mit Hilfe dieses super Forums und ein wenig selber basteln habe ich mir nachfolgende Makros gebaut, welche mit Hilfe des ersten Makros nacheinander ablaufen sollen. Das Problem ist, dass die Makros nacheinander nicht ablaufen weil:
1. Das Makro "Ausblenden" nur funktioniert, wenn ich mich in einem der Blätter "Klasse1" bis "Klasse20" befinde, es müsste aber von jedem Blatt aus aufgerufen werden können.
2. Das letzte Makro "Speichern_unter" nur funktioniert, wenn ich mich im Blatt "Artikel" befinde, dies müsste aber auch von jedem Blatt aus funktionieren, weil das Blatt "Artikel" durch eines der vorherigen Makros ("ausblendenListen") ausgeblendet wird und alle Blätter durch das Makro "schützenBlätter" geschütz werden.
Ich möchte mir später ein AddIn basteln, mit Hilfe dessen ich über eine Schaltfläche das erste Makro ("StartMakro") ausführen kann (und dadurch die folgenden und noch ein par andere).
Kann mir Jemand bei den beiden nicht funktionierenden Makros helfen, wäre super.
Danke schon mal.
mfg, Helmut
Sub StartMakro()
MsgBox "Betselllisten unter Artikelnummer speichern"
aufhebenBlattschutz
Ausblenden
ausblendenListen
schützenBlätter
SPEICHER_UNTER
End Sub
Sub aufhebenBlattschutz()
Dim intSheet As Integer
Dim strPass As String
On Error GoTo ErrEnd
'strPass = InputBox("Das Passwort bitte")
Application.ScreenUpdating = False
'Blattschutz aufheben:
For intSheet = 1 To Worksheets.Count
Worksheets(intSheet).Unprotect 'strPass
Next intSheet
Application.ScreenUpdating = True
ErrEnd:
Err.Clear
End Sub
Sub Ausblenden()
Dim wks As Worksheet
Dim TabName As String
Dim I As Integer 'Zähler für Spalten D bis S
Dim X As Integer 'Zahler für Blätter 2 bis 21
Set wks = ActiveSheet
TabName = "Klasse" 'Name der Blätter ohne Index
For I = 4 To 19
If wks.Cells(1, I) = 0 Then
For X = 1 To 20
Sheets(TabName & X).Columns(I).EntireColumn.Hidden = True
Next '& ""
Else
For X = 1 To 20
Sheets(TabName & X).Columns(I).EntireColumn.Hidden = False
Next
End If
Next
End Sub
Sub ausblendenListen()
'ausblenden der Listen Artikel, VorOrtUeberweisungslisten, VorOrtAbrechnung
ActiveWorkbook.Unprotect
Sheets("Artikel").Visible = False
Sheets("VorOrtUeberweisungslisten").Visible = False
Sheets("VorOrtAbrechnung").Visible = False
Sheets("Einzelueberweisungen").Visible = False
End Sub
Sub schützenBlätter()
Dim intSheet As Integer
Application.ScreenUpdating = False
'Blaetter schuetzen:
For intSheet = 1 To Worksheets.Count
Worksheets(intSheet).Protect '"Das Passwort" hier musst du dein Passwort eingeben
Next intSheet
Application.ScreenUpdating = True
End Sub
Sub SPEICHER_UNTER()
'Speichert die Mappe unter D:\Bestelllisten\(Inhalt Zelle D8, Artikelblatt),
' wenn dort ein Wert steht
ActiveWorkbook.Protect
If Range("D8") = "" Then GoTo FINI
x = "D:\Gravurlisten\"
y = Sheets("Artikel").Range("D8")
SPEINAM2 = x & y & ".xls"
ActiveWorkbook.SaveAs Filename:=(SPEINAM2), FileFormat:=xlExcel9795, ReadOnlyRecommended:=False, CreateBackup:=True
FINI:
End Sub