Parametrik Prosedür

[hsayar]

Aşağıdaki kodlar sorunsu çalışıyor, ancak

Sub Alansec()
    SnDlSt = [d65536].End(3).Row    '55
    Range("A1:G" & SnDlSt).Select: Selection.Copy
    Call SeciliAlaniWordeYapistir_D
End Sub
Private Sub SeciliAlaniWordeYapistir_D()
'A4 sayfa yapısı dikeydir
Application.ScreenUpdating = True
    'Range("A1:L5" & SnDlSt + 7).Copy
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
        .TopMargin = 42.55
        .BottomMargin = 42.55
        .LeftMargin = 25#
        .RightMargin = 25#
        .PageWidth = 595.35 'CentimetersToPoints(21)
        .PageHeight = 841.95 'CentimetersToPoints(29,7)
        End If
    End With
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

ben aşağıdaki şekilde kullanmak istiyorum

Sub Alansec()
    SnDlSt = [d65536].End(3).Row    '55
    Range("A1:G" & SnDlSt).Select: Selection.Copy
[color="red"]    Call SeciliAlaniWordeYapistir_D (üst,alt,sağ,sol,yon) [/color]
End Sub
Private Sub SeciliAlaniWordeYapistir_D()
'A4 sayfa yapısı dikeydir
Application.ScreenUpdating = True
    'Range("A1:L5" & SnDlSt + 7).Copy
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
[color="red"]        .TopMargin = ust
        .BottomMargin = alt
        .LeftMargin = sol
        .RightMargin = sag
        If yon = "dky" Then  [/color]
            .PageWidth = 595.35 'CentimetersToPoints(21)
            .PageHeight = 841.95 'CentimetersToPoints(29,7)
        Else
            .PageWidth = 841.95 'CentimetersToPoints(29.7)   'yataysayfa
            .PageHeight = 595.35 'CentimetersToPoints(21)    'yataysayfa
        End If
    End With
    
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

nasıl bir değişklik yapmalıyım

 

[Recep İpek]

Sub Alansec()
SnDlSt = [d65536].End(3).Row '55
Range("A1:G" & SnDlSt).Select: Selection.Copy
Call SeciliAlaniWordeYapistir_D (44,45,25,25)
End Sub
Private Sub SeciliAlaniWordeYapistir_D(üst,alt,sağ,sol,yon)
'A4 sayfa yapısı dikeydir
Application.ScreenUpdating = True
'Range("A1:L5" & SnDlSt + 7).Copy
Set objword = CreateObject("Word.Application")
Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
objword.Visible = True
....
....
olarak denermisiniz?

 

[hsayar]

Sub Alansec()
    SnDlSt = [d65536].End(3).Row    '55
    Range("A1:G" & SnDlSt).Select: Selection.Copy
    Call SeciliAlaniWordeYapistir(42.55, 42.55, 100, 25, "dky")
End Sub

Private Sub SeciliAlaniWordeYapistir(ust, alt, sol, sag, yon)
'A4 sayfası
Application.ScreenUpdating = True
    'Range("A1:L5" & SnDlSt + 7).Copy
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
        .TopMargin = ust '42.55
        .BottomMargin = alt    '42.55
        .LeftMargin = sol     '25#
        .RightMargin = sag    '25#
        If yon = "dky" Then
            .PageWidth = 595.35 'CentimetersToPoints(21)
            .PageHeight = 841.95 'CentimetersToPoints(29,7)
        Else
            .PageWidth = 841.95 'CentimetersToPoints(29.7)   'yataysayfa
            .PageHeight = 595.35 'CentimetersToPoints(21)    'yataysayfa
        End If
    End With
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

hocam çok teşekkürler yalnız bir sorum daha olacak

Call SeciliAlaniWordeYapistir(42.55, 42.55, 100, 25, "dky") satırında
Call SeciliAlaniWordeYapistir(42.55, 42.55, 100, 25, sonra "yty", "dky" iye seçenekler gelse tıpkı false true gibi mümkün mü?

 

[Recep İpek]

Bu mümküm olmayabilir.

 

[hsayar]

üzüldüm umarım mümkündür false true gelsede olur prosodürde Ture ise dikey uzunlukarı false ise yatay uzunlukları veririz.

 

[hsayar]

Private Sub SeciliAlaniWordeYapistir(ust, alt, sol, sag, yon)

ayrıca buradaki ust, alt, sol, sag, yon değişkenlerini projede kullanmam sakınca yaratırmı?

 

[Recep İpek]

Biraz uğraşınca oluyormuş.

Sanırım bu şekil istiyorsunuz.

Sub Alansec()
    SnDlSt = [d65536].End(3).Row    '55
    Range("A1:G" & SnDlSt).Select: Selection.Copy
    Call SeciliAlaniWordeYapistir(42.55, 42.55, 100, 25, [COLOR=blue]True[/COLOR])
End Sub

Private Sub SeciliAlaniWordeYapistir(ust, alt, sol, sag [COLOR=blue]As Integer[/COLOR], yon [COLOR=blue]As [/COLOR][COLOR=blue]Boolean[/COLOR])
'A4 sayfası
Application.ScreenUpdating = True
    'Range("A1:L5" & SnDlSt + 7).Copy
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
        .TopMargin = ust '42.55
        .BottomMargin = alt    '42.55
        .LeftMargin = sol     '25#
        .RightMargin = sag    '25#
        If yon = [COLOR=blue]True [/COLOR]Then
            .PageWidth = 595.35 'CentimetersToPoints(21)
            .PageHeight = 841.95 'CentimetersToPoints(29,7)
        Else
            .PageWidth = 841.95 'CentimetersToPoints(29.7)   'yataysayfa
            .PageHeight = 595.35 'CentimetersToPoints(21)    'yataysayfa
        End If
    End With
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

 

[hsayar]

teşekkürler hocam....

birde şu
ust, alt, sol, sag As Integer değerlerini nokta yerine cm cinsinden verebilsek çok daha mükemmel olacak

1) birde bu değerler artık aynı projedeki değerlerideki başak prosodürler için kullanılabilirmi?

2) xla dosyamda alttaki kodları tutsam kitiatp birden üstteki kodları çağırsam
mümkünatı nedir.

 

[hsayar]

sn hocam
DataType:=10
burada yer alan 10 değeri Tablo olarak yapıştırmaya yarıyor
peki diğer alternetifler nedir? Ulaşabileceğim bir dökuman varmı?