sscey
Altın Üye
- Katılım
- 16 Şubat 2005
- Mesajlar
- 80
- Excel Vers. ve Dili
- Office 365 Türkçe
- Altın Üyelik Bitiş Tarihi
- 05-12-2024
Hergün internetten sıklıkla indirdiğim ve şekillendirip yazdırdığım bir tablom var. Bu tabloyu şekillendirme ve yazdırma ile ilgili bir macro oluşturdum, şekillendir ve yazdır şeklindede bir butonum var ona tıkladığmdada başarıyla da çalışıyor. Macroyu, "macro oluştur" ile yaptığımdan çok uzun ve birazda yavaş çalışıyor, sizden isteğim bu macroyu kısaltabilirmiyiz? Dosya ektedir, yardımcı olursanız sevinirim.[vb:1:049a5f9372]Sub Sevk()
'
' Sevk Makro
' Makro dore tarafından 04.12.2005 tarihinde kaydedildi.
'
' Klavye Kısayolu: Ctrl+s
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"BAÃLIK1" & Chr(10) & "BAÃLIK2" & Chr(10) & "BAÃLIK4" & Chr(10) & "BAÃLIK5" & Chr(10) & "BAÃLIK7"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&D &T" & Chr(10) & "ALTBAÃLIK 1"
.RightFooter = "Tel: 499 99 99"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.84251968503937)
.BottomMargin = Application.InchesToPoints(0.584251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -2
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 75
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A313").Select
With Selection.Font
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A10").Select
Columns("A:A").ColumnWidth = 27.14
Rows("10:10").RowHeight = 34.5
Rows("12:12").RowHeight = 32.25
Rows("13:13").RowHeight = 53.25
Range("A413").Select
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B10:B12").Select
Selection.Font.Bold = True
Range("D1012").Select
Selection.Font.Bold = True
Range("B10:B12").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1012").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A313").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
[/vb:1:049a5f9372]
'
' Sevk Makro
' Makro dore tarafından 04.12.2005 tarihinde kaydedildi.
'
' Klavye Kısayolu: Ctrl+s
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"BAÃLIK1" & Chr(10) & "BAÃLIK2" & Chr(10) & "BAÃLIK4" & Chr(10) & "BAÃLIK5" & Chr(10) & "BAÃLIK7"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&D &T" & Chr(10) & "ALTBAÃLIK 1"
.RightFooter = "Tel: 499 99 99"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.84251968503937)
.BottomMargin = Application.InchesToPoints(0.584251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -2
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 75
.PrintErrors = xlPrintErrorsDisplayed
End With
Range("A313").Select
With Selection.Font
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A10").Select
Columns("A:A").ColumnWidth = 27.14
Rows("10:10").RowHeight = 34.5
Rows("12:12").RowHeight = 32.25
Rows("13:13").RowHeight = 53.25
Range("A413").Select
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B10:B12").Select
Selection.Font.Bold = True
Range("D1012").Select
Selection.Font.Bold = True
Range("B10:B12").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D1012").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A313").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
[/vb:1:049a5f9372]