AW: Bidschirmaktuallisierung, Textbox
19.08.2004 20:23:47
mario
hallo
hier das Makro archivieren.Archivieren und die dazugehörigen Makros.Es ziemlich lang.
Zu Frage 2. Sorry ich verstehe dich nicht gibst du mir bitte ein Beispiel.
gruss Mario
Sub Archivieren()
Dim i
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(Array("Titelblatt", "Datenbank", "Zeit-Rechnung", "Zeit-Rechnung2", _
"Abrisse2", "Auswertungen", "Auswertung", "Diagramme", "Störungen2", _
"Techn. ungeplant")).Copy
range("A1").Select
Sheets("Datenbank").Name = "Produktionsbuch"
Sheets("Abrisse2").Name = "Abrisse"
Sheets("Störungen2").Name = "Störungen"
Makro4
Sheets("Titelblatt").Visible = True
Sheets("Abrisse").Visible = True
Sheets("Störungen").Visible = True
Sheets("Produktionsbuch").Shapes("Text Box 1").Delete
Sheets("Zeit-Rechnung2").Shapes("Text Box 1").Delete
Sheets("Zeit-Rechnung").Shapes("Text Box 1").Delete
Sheets("Auswertungen").Shapes("Text Box 3").Delete
Sheets("Störungen").Select
Sheets("Abrisse").Select
ActiveSheet.Shapes("Text Box 5").Select
Selection.Delete
ActiveSheet.Shapes("Text Box 4").Select
Selection.Delete
Columns("AI:AK").Select
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = xlNone
Columns("AI:AK").Select
Selection.Font.ColorIndex = 2
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
range("B1").Select
Festwerte
End Sub
Sub Festwerte()
Application.ScreenUpdating = False
Dim i
For i = 1 To Worksheets.Count
On Error Resume Next
Sheets(i).Unprotect
Sheets(i).Select
Application.CutCopyMode = False
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
range("A1").Select
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.TabRatio = 0.945
Next i
Sheets("Auswertung").Select
ActiveSheet.Shapes("Spinner 3").Select
Selection.Delete
Sheets("Techn. ungeplant").Select
ActiveSheet.Shapes("Spinner 3").Select
Selection.Delete
Sheets("Auswertung").Columns("K:R").Delete Shift:=xlToLeft
Sheets("Störungen").Columns("Q:T").Delete Shift:=xlToLeft
Sheets("Produktionsbuch").Rows("3:4").EntireRow.Hidden = True
schutz
End Sub
Sub schutz()
Application.ScreenUpdating = False
Dim t As Integer
Dim i As Integer
Dim sFile As String, sPath As String, sJahr As String
t = ActiveWorkbook.Worksheets.Count
For i = 1 To t
On Error Resume Next
Sheets(i).Unprotect
Sheets(i).Select
Cells.Select
Selection.Locked = True
Sheets(i).Protect
range("A1").Select
Next i
Startseite
sPath = Application.DefaultFilePath & "\" & " PM 5" & "_"
sFile = Worksheets("Auswertung").range("C1").Value
sFile = Format(CDate(sFile), "yyyymmdd") & ".xls"
sJahr = Worksheets("Abrisse").range("AF3").Value
Workbooks.Open ActiveWorkbook, Password:="mario"
ActiveWorkbook.SaveAs sPath & sFile & "_" & sJahr, WriteResPassword:="mario", ReadOnlyRecommended:=True
ActiveWorkbook.Close
MsgBox "Archivieren beendet"
Application.DisplayAlerts = False
End Sub