Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Ocak 2006 Pazar

Full Fields On The Page To Print a Single Template



'ThisWorkBook.Sheets("BlogArşivi") Module

Private Sub CommandButton1_Click()
On Error Resume Next
YGSA = "BlogArşivi"
YGAKA = 12
YGASA = 25
YGAKT = 3
YGAST = 20
SSA = 5
SKA = 2
LH = ""
CH = ""
RH = ""
LF = ""
CF = ""
RF = ""
LM = 0.5 * Sabit
RM = 0.5 * Sabit
TM = 1 * Sabit
BM = 0.5 * Sabit
HM = 0 * Sabit
FM = 0 * Sabit
PH = 0
PG = 0
PC = xlPrintNoComments
PQ = 600
CHo = 1
CVe = 1
Ort = 2
Dft = False
PS = xlPaperA4
FPN = xlAutomatic
Ord = xlDownThenOver
BW = False
Zm = False
FPW = 1
FPT = 1
PEr = xlPrintErrorsDisplayed
Cops = 1
Coll = 1
YazdırmaAlanıTesbiti YGSA, SKA, SSA, YGAKA, YGASA, YGAKT, YGAST
End Sub

'Module1

Option Explicit
Dim i As Single, ii As Single
Public Const Sabit = (0.984251968503937 / 2.5)
Public xK(2) As Double, yK(2) As Double
' x ve y Koordinatları
Public YGAA As Range
'Yazıcıya Gönderilecek Alanın Adresi
Public YGATD As Double
'Yazıcıya Gönderilecek Alanın Toplam Değeri
Public YGSA As String
'Yazıcıya Gönderilecek Sayfa Adı; Default= PERSONAL
Public YGAKA As Double
'Yazıcıya Gönderilen Alanın Kolon Adedi; Default= PERSONEL
Public YGASA As Double
'Yazıcıya Gönderilen Alanın Satır Adedi; Default= PERSONEL
Public YGAKT As Double
'Yazıcıya Gönderilen Alanın Kolon Tekrarı; Default= PERSONEL
Public YGAST As Double
'Yazıcıya Gönderilen Alanın Satır Tekrarı; Default= PERSONEL
Public SKA As Double
'Sabit Kolon Adedi
Public SSA As Double
'Sabit Satır Adedi
Public PTR As String
'PrintTitleRows; Default= 0

Public PTC As String 'PrintTitleColumns; Default= 0
Public PA As String 'PrintArea; Default= PERSONAL
Public LH As Variant
'LeftHeader; Default= ""
Public CH As Variant
'CenterHeader; Default= ""

Public RH As Variant 'RightHeader; Default= ""
Public LF As Variant 'LeftFooter; Default= ""
Public CF As Variant 'CenterFooter; Default= ""
Public RF As Variant
'RightFooter; Default= ""
Public LM As Double
'LeftMargin; Default= 0.748031496062992 [1,9]
Public RM As Double
'RightMargin; Default= 0.748031496062992 [1,9]

Public TM As Double 'TopMargin; Default= 0.984251968503937 [2,5]
Public BM As Double 'BottomMargin; Default= 0.984251968503937 [2,5]
Public HM As Double 'HeaderMargin; Default= 0.511811023622047 [1,3]
Public FM As Double 'FooterMargin; Default= 0.511811023622047 [1,3]
Public PH As Boolean 'PrintHeadings; Default= False [0]
Public PG As Boolean 'PrintGridlines; Default= False [0]
Public PC As Variant
'PrintComments; Default= xlPrintNoComments
Public PQ As Double
'PrintQuality; Default= 300
Public CHo As Boolean
'CenterHorizontally; Default= False [0]

Public CVe As Boolean 'CenterVertically; Default= False [0]
Public Ort As Variant
'Orientation; Default= xlPortrait [1], xlLandsCape [2]

Public Dft As Boolean 'Draft; Default= False [0]
Public PS As Variant
'PaperSize; Default= xlLetter], xlLegal,xlPaperExecutive, xlPaperA4, xlPaperA3

Public FPN As Variant 'FirstPageNumber; Default= xlAutomatic
Public Ord As Variant
'Order; Default= xlDownThenOver

Public BW As Boolean 'BlackAndWhite; Default= False
Public Zm As Variant
'Zoom; Default= 100

Public FPW As Double 'FitToPagesWide; Default= 1
Public FPT As Double 'FitToPagesTall; Default= 1
Public PEr As Variant 'PrintErrors; Default= xlPrintErrorsDisplayed
Public Cops As Double
'Print Copies

Public Coll As Boolean 'Print Collate
Public Function YazdırmaAlanıTesbiti(YGSA, SKA, SSA, YGAKA, YGASA, YGAKT, YGAST)
On Error Resume Next
With Sheets(YGSA)
PTC = "$A:" & VBA.Left(Cells(1, SKA).Address, VBA.Len(Cells(1, SKA).Address) - 2)
PTR = "$1:$" & SSA
With .PageSetup
.PrintTitleRows = PTR
.PrintTitleColumns = PTC
.LeftHeader = LH
.CenterHeader = CH
.RightHeader = RH
.LeftFooter = LF
.CenterFooter = CF
.RightFooter = RF
.LeftMargin = Application.InchesToPoints(LM)
.RightMargin = Application.InchesToPoints(RM)
.TopMargin = Application.InchesToPoints(TM)
.BottomMargin = Application.InchesToPoints(BM)
.HeaderMargin = Application.InchesToPoints(HM)
.FooterMargin = Application.InchesToPoints(FM)
.PrintHeadings = PH
.PrintGridlines = PG
.PrintComments = PC
.PrintQuality = PQ
.CenterHorizontally = CHo
.CenterVertically = CVe
.Orientation = Ort
.Draft = Dft
.PaperSize = PS
.FirstPageNumber = FPN
.Order = Ord
.BlackAndWhite = BW
.Zoom = Zm
.FitToPagesWide = FPW
.FitToPagesTall = FPT
.PrintErrors = PEr
End With
For i = 1 To YGAKT
For ii = 1 To YGAST
xK(1) = (SSA + 1) + (ii - 1) * YGASA
yK(1) = (SKA + 1) + (i - 1) * YGAKA
xK(2) = xK(1) + YGASA - 1
yK(2) = yK(1) + YGAKA - 1
Set YGAA = Range(Cells(xK(1), yK(1)), Cells(xK(2), yK(2)))
YGATD = Application.WorksheetFunction.Sum(YGAA)
If (YGATD > 0) Then
PA = YGAA.Address
.PageSetup.PrintArea = PA
.PrintOut Copies:=Cops, Collate:=Coll
End If
Next ii
Next i
End With
End Function

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul