AW: kann ich nicht bestätigen ... Breite bleibt gleich
17.10.2012 11:47:17
Peter
Hallo Matthias,
hier mein kompletter Code, habe aber schon ein wenig an der Spaltenbreite gebastelt... aber ändert sich nix
Sub neuer_Auftrag()
' neuer_Auftrag Makro
' fügt im Tabellenblatt Berechnung eine neue Auftragtabelle hinzu
'Zelle A1:A4 sollen miteinand3er verbunden werden
ActiveCell.Range("A1:D1").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
'Spalte A;B;C sollen 3,57 also 30 Pixel breit sein
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 3.57
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 3.57
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 3.57
ActiveCell.Offset(0, 1).Range("A1").Select
'Spalte D soll6,43 also 50 Pixel breit sein
ActiveCell.Columns("A:A").EntireColumn.ColumnWidth = 3.57
ActiveCell.Offset(0, -3).Range("A1").Select
'In Zelle A2 steht BU
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = "BU"
'In Zelle B2 Steht BI
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "BI"
'In Zelle C2 sthet GR
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "GR"
'In Zelle D2 steht Sonder
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.Value = "Sonder"
ActiveCell.Offset(-1, -3).Range("A1").Select
'Bereich A1 bis D45 soll komplett schwarzen Rahmen erhalten
'Bereich A1 bis D45 soll außen einen dicken Rahmen erhalten
Selection.Merge
ActiveCell.Range("A1:D45").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
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 = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveCell.Offset(4, 1).Range("A1").Select
End Sub
Vielen Dank