AW: Hat wer eine Idee
30.01.2020 13:46:12
Phips
Ja aber wie könnte ich das verhindern?
Der Code wäre:
Sub Start()
' Tabelle Makro
' Tastenkombination: Strg+Umschalt+G
Application.ScreenUpdating = False
ActiveSheet.Name = ("Tabelle1")
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Rohwerte"
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Auswertung"
Sheets("Auswertung").Select
Range("B1:G6").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$G$9"), , xlNo).Name = _
"Tabelle1"
Range("Tabelle1[#All]").Select
ActiveSheet.ListObjects("Tabelle1").ShowAutoFilterDropDown = False
ActiveSheet.ListObjects("Tabelle1").TableStyle = "TableStyleMedium8"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("Tabelle1[[#Headers],[Spalte1]]").Select
ActiveCell.FormulaR1C1 = "Spalte1"
Range("Tabelle1[[#Headers],[Spalte1]]").Select
ActiveCell.FormulaR1C1 = "NR"
Range("Tabelle1[[#Headers],[Spalte2]]").Select
ActiveCell.FormulaR1C1 = "SACHNUMMER"
Range("Tabelle1[[#Headers],[Spalte3]]").Select
ActiveCell.FormulaR1C1 = "AUFTRAGSNUMMER"
Range("Tabelle1[[#Headers],[Spalte4]]").Select
ActiveCell.FormulaR1C1 = "GRÖSSE"
Range("Tabelle1[[#Headers],[Spalte5]]").Select
ActiveCell.FormulaR1C1 = "ANZAHL"
Range("Tabelle1[[#Headers],[Spalte6]]").Select
ActiveCell.FormulaR1C1 = "GEWICHT"
Range("I1:I10").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$I$1:$I$10"), , xlNo).Name = _
"Tabelle2"
Range("Tabelle2[[#All],[Spalte1]]").Select
ActiveSheet.ListObjects("Tabelle2").TableStyle = "TableStyleMedium8"
ActiveSheet.ListObjects("Tabelle2").ShowAutoFilterDropDown = False
Range("Tabelle2[[#Headers],[Spalte1]]").Select
ActiveCell.FormulaR1C1 = "OPERATOR-ID"
Range("I2").Select
Columns("I:I").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Range("B11:B13").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "PROGRAMM BESCHREIBUNG"
Range("B11:B13").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Columns("B:B").Select
Selection.ColumnWidth = 12
Columns("B:B").Select
Selection.ColumnWidth = 15
Range("B11:B13").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B11:B13").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.Bold = True
Columns("C:C").Select
Selection.ColumnWidth = 180
ActiveWindow.LargeScroll ToRight:=-1
Selection.ColumnWidth = 18
Columns("D:D").Select
Selection.ColumnWidth = 18
Range("C8:G10").Select
Selection.Copy
Range("C11").Select
ActiveSheet.Paste
Range("B11:G13").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Range("B1:G13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Columns("H:H").ColumnWidth = 4.73
Range("I1:I2").Select
Selection.Copy
Range("I3").Select
ActiveSheet.Paste
Range("I3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "PROGRAMM-NUMMER"
Range("I5").Select
ActiveCell.FormulaR1C1 = "CHARGENDATEN-NUMMER"
Range("I7").Select
ActiveCell.FormulaR1C1 = "OFEN-NUMMER"
Range("I9").Select
ActiveCell.FormulaR1C1 = "START-DATUM"
Range("I11").Select
ActiveCell.FormulaR1C1 = "FREIER TEXT ZUR CHARGE"
Columns("J:J").Select
Columns("I:I").EntireColumn.AutoFit
Range("I3,I5,I7,I9,I11").Select
Range("I11").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("Tabelle2[[#Headers],[OPERATOR-ID]]").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("G12:G13").Select
Selection.Copy
Range("I12").Select
ActiveSheet.Paste
Range("I13").Select
Application.CutCopyMode = False
Selection.Copy
Range("I12").Select
ActiveSheet.Paste
Range("H16").Select
Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.787401575)
.BottomMargin = Application.InchesToPoints(0.787401575)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Range("I1:I13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("I12").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("I3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("I6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("I7").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("I9").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("I11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWorkbook.Save
Sheets("Auswertung").Select
Call Tabelle_Bezug
End Sub
Sub Tabelle_Bezug()
' Tabelle_Bezug Makro
' Tastenkombination: Strg+Umschalt+B
Range("B2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[1]"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[2]"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[3]"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[4]"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[5]"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[10]C[5]"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[20]C[-6]"
Range("I4").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[1]C[-6]"
Columns("I:I").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("I6").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[-4]C[-6]"
Range("I8").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[-3]C[-3]"
Range("I10").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!RC[-6]"
Range("I12").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[12]C[-6]"
Range("I13").Select
ActiveCell.FormulaR1C1 = "=Rohwerte!R[12]C[-6]"
Range("I12:I13").Select
Selection.NumberFormat = "@"
Range("I17").Select
ActiveWorkbook.Save
Call Diagramm
End Sub
Sub Rohwerte_übertragen()
' Rohdaten_übertragen Makro
Sheets("Auswertung").Select
Range("L1").Select
ActiveCell.Formula2R1C1 = "=Rohwerte!R[28]C[-6]:R[1115]C[-6]"
Range("M1").Select
ActiveCell.Formula2R1C1 = "=Rohwerte!R[28]C[-6]:R[1115]C[-6]"
Columns("L:M").Select
Selection.NumberFormat = "0.00"
Range("H18").Select
Range("K1").Select
ActiveCell.Formula2R1C1 = "=Rohwerte!R[28]C[-8]:R[1115]C[-8]"
Range("K11").Select
Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
Range("K1").Select
Range(Selection, Selection.End(xlDown)).Select
Columns("K:K").Select
Range("K1057").Activate
Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
Call Diagramm
End Sub
Sub Diagramm()
Dim MeinDiagramm As Chart
Dim lng_letzte_zeile As Long
Dim Rahmen As ChartObject
lng_letzte_zeile = Worksheets("Rohwerte").Cells(Rows.Count, 7).End(xlUp).Row
Set Rahmen = Worksheets("Auswertung").ChartObjects.Add(52, 220, 627, 230)
Set MeinDiagramm = Rahmen.Chart
MeinDiagramm.ChartType = xlLine
MeinDiagramm.SetSourceData Worksheets("Rohwerte").Range("F29:G" & lng_letzte_zeile), PlotBy _
:=xlColumns
MeinDiagramm.FullSeriesCollection(1).XValues = "=Rohwerte!C29:C1116"
MeinDiagramm.FullSeriesCollection(1).Name = "=""SOLL"""
MeinDiagramm.FullSeriesCollection(2).Name = "=""IST"""
MeinDiagramm.HasTitle = True
MeinDiagramm.ChartTitle.Text = "Glühkurve"
MeinDiagramm.Axes(xlValue, xlPrimary).HasTitle = True
MeinDiagramm.Axes(xlValue, xlPrimary).AxisTitle.Text = "Temp[°C]"
MeinDiagramm.Axes(xlCategory).HasTitle = True
MeinDiagramm.Axes(xlCategory).AxisTitle.Text = "Zeit[hh:mm:ss]"
MeinDiagramm.FullSeriesCollection(1).Select
With Selection.Format.Line
.Visible = msoTrue
.Weight = 5
End With
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
End With
MeinDiagramm.FullSeriesCollection(2).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.349999994
.Transparency = 0
End With
Call Diagramm_bearbeiten
End Sub
Sub Diagramm_bearbeiten()
Dim MeinDiagramm As Chart
Dim Rahmen As ChartObject
Set Rahmen = Worksheets("Auswertung").ChartObjects(1)
Set MeinDiagramm = Rahmen.Chart
ActiveWindow.ScrollRow = 1055
ActiveWindow.ScrollRow = 1053
ActiveWindow.ScrollRow = 1049
ActiveWindow.ScrollRow = 1044
ActiveWindow.ScrollRow = 1039
ActiveWindow.ScrollRow = 1035
ActiveWindow.ScrollRow = 1032
ActiveWindow.ScrollRow = 1028
ActiveWindow.ScrollRow = 1026
ActiveWindow.ScrollRow = 1021
ActiveWindow.ScrollRow = 1012
ActiveWindow.ScrollRow = 999
ActiveWindow.ScrollRow = 976
ActiveWindow.ScrollRow = 835
ActiveWindow.ScrollRow = 652
ActiveWindow.ScrollRow = 166
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 109
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 1
Columns("A:A").Select
Selection.ColumnWidth = 8
Columns("I:I").Select
Selection.ColumnWidth = 21
Range("A1:I32").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$32"
Application.ScreenUpdating = True
UserForm1.Show
End Sub
Sub PDF()
UserForm1.Show
End Sub