Listede Çizim

talatcd · 28 Haziran 2007

Selam Üstadlar, Bordro sayfasına aktarım yapıyorum fakat bordro sayfasının A5 hücresinden başlayarak N sütununa kadar Çizmek istiyorum. A sütununun son dolu satırının bir alt satırıda dahil olacak. Aşağıdaki kodla yapmak istedim fakat tek bir satırı çiziyor. Çizim olmassa bu alanların hücre çizgilerinin yazıcıda gözükmeside olur. Yardımcı olursanız sevinirm.

a = WorksheetFunction.CountA(Sheets("Bordro").Range("B5:B65536"))
If a Mod 1 = 0 Then
adr = "a" & a + 5 & ":N" & a + 5
s2.Range(adr).Borders(xlEdgeTop).Weight = xlThin
s2.Range(adr).Borders(xlEdgeBottom).Weight = xlThin
s2.Range(adr).Borders(xlEdgeLeft).Weight = xlThin
s2.Range(adr).Borders(xlEdgeRight).Weight = xlThin
End If

Orion1 · 28 Haziran 2007

Merhaba.
Aşağıdaki gibi denermisiniz.

Kod:

a = WorksheetFunction.CountA(Sheets("Bordro").Range("B5:B65536"))
If a Mod 1 = 0 Then
adr = "a" & a + 4 & ":N" & a + 5
s2.Range(adr).Borders(xlEdgeTop).Weight = xlThin
s2.Range(adr).Borders(xlEdgeBottom).Weight = xlThin
s2.Range(adr).Borders(xlEdgeLeft).Weight = xlThin
s2.Range(adr).Borders(xlEdgeRight).Weight = xlThin
End If

talatcd · 28 Haziran 2007

İlgin için teşekkür ederim sezar fakat olmadı; 4. satır ile 5. satırı tek bir çizgiyle çiziyor. Arasına çizgi atmıyor.

talatcd · 28 Haziran 2007

Butonun tüm kodlarını ekledim

Private Sub CommandButton1_Click() ' Belirli Sütunların Aktarılması ve Toplam Alınması
Set s1 = Sheets("Parametre")
Set s2 = Sheets("Bordro")
s2.Select
Range("A2:O1000").Select 'Belirtilen hücre aralığını seç
Selection.ClearContents 'Belirtilen hücre aralığını sil
[a1] = b
a = WorksheetFunction.CountA(Sheets("Bordro").Range("B5:B65536"))
If a Mod 1 = 0 Then
adr = "a" & a + 4 & ":N" & a + 5
s2.Range(adr).Borders(xlEdgeTop).Weight = xlThin
s2.Range(adr).Borders(xlEdgeBottom).Weight = xlThin
s2.Range(adr).Borders(xlEdgeLeft).Weight = xlThin
s2.Range(adr).Borders(xlEdgeRight).Weight = xlThin
End If
Sheets("Veri").Select 'Veri Sayfasını Seç
s2.[a1] = [b14].Text 'Veri Sayfasının B14 hücresini Bodro sayfasının A1 hücresine kayded
s2.[b2] = [a1].Text
s2.[c2] = [b1]
s2.[l3] = [b12]
s2.[n3] = [b13]
s2.[m2] = [a12]
s1.Select 'Parametre Sayfasını Seç
a = Array(1, 2, 4, 8, 9, 24, 11, 12, 13, 14, 15, 16, 17, 18)
sat = 3 'Üç satır boş bırak 4. satırdan başla
For x = 1 To [a65536].End(3).Row 'Paremetre sayfasının A sütunundan başla
If Cells(x, 24) > 0 Then '24. sütun sıfırdan büyük ise ekle
sat = sat + 1 'bir artarak say
For y = 1 To 14 '14 sütun kopyala
s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
Next
End If
Next x
a = Array(7, 8, 9, 10, 11, 12, 13, 14)
For y = 0 To 7
s2.Cells(sat + 1, a

) = WorksheetFunction.Sum(Range(s2.Cells(8, a

), s2.Cells(sat, a

)))
Next
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "TOPLAM" 'En Son Satıra TOPLAM yazmak
Sheets("Bordro").Range("C65536").End(xlUp).Offset(4, 0).Value = Sheets("Veri").[A9]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(5, 0).Value = "Adı Soyadı :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(2, 0).Value = Sheets("Veri").[B9]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "Ünvanı :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B10]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "İmza :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B11]
Sheets("Bordro").Range("I65536").End(xlUp).Offset(3, 0).Value = Sheets("Veri").[A6]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(5, 0).Value = "Adı Soyadı :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(5, 0).Value = Sheets("Veri").[B6]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(1, 0).Value = "Ünvanı :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B7]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(1, 0).Value = "İmza :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B8]
End Sub

Orion1 · 28 Haziran 2007

Merhaba.
Aşağıdaki şekilde denermisiniz?

Kod:

a = WorksheetFunction.CountA(Sheets("Bordro").Range("B5:B65536"))
If a Mod 1 = 0 Then
adr1 = "a" & a + 4 & ":N" & a + 4
adr2 = "a" & a + 5 & ":N" & a + 5
s2.Range(adr1).Borders(xlEdgeTop).Weight = xlThin
s2.Range(adr1).Borders(xlEdgeBottom).Weight = xlThin
s2.Range(adr1).Borders(xlEdgeLeft).Weight = xlThin
s2.Range(adr1).Borders(xlEdgeRight).Weight = xlThin
s2.Range(adr2).Borders(xlEdgeTop).Weight = xlThin
s2.Range(adr2).Borders(xlEdgeBottom).Weight = xlThin
s2.Range(adr2).Borders(xlEdgeLeft).Weight = xlThin
s2.Range(adr2).Borders(xlEdgeRight).Weight = xlThin

talatcd · 28 Haziran 2007

Sezar ilgin için teşekkür ederim fakat iki satırı çiziyor. ben A stüunun son dolu satırının bir alt satırına kadar çizmesini istiyorum.

Orion1 · 28 Haziran 2007

Küçük bir örnek dosya yollarsanız.Ne yapmak istediğinizde dosyada açıklarsanız.Soru dağa iyi anlaşılacaktır.

Korhan Ayhan · 28 Haziran 2007

Selamlar,

Aşağıdaki kodu denermisiniz. Sanırım kendi kodunuza uyarlayabilirsiniz.

Kod:

Sub &#199;&#304;ZG&#304;_&#199;&#304;Z()
    Set S2 = Sheets("Bordro")
    SON_SATIR = S2.[A65536].End(3).Row + 1
    ADRES = Range("A5:N" & SON_SATIR).Address
    With S2.Range(ADRES)
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlEdgeRight).Weight = xlThin
    .Borders(xlInsideVertical).Weight = xlThin
    .Borders(xlInsideHorizontal).Weight = xlThin
    End With
End Sub

talatcd · 29 Haziran 2007

Slm Üstadadlar yardımlarınız için çok teşekkür ederim fakat olmadı; dosyayı ekte gönderiyorum. Bordro Formundan > Bordro Oluştur Düğmesine yazılacak formül. Ekteki dosyayı bir inceleyerek yardımcı olursanız sevinirim.
Bir de işten çıkanlar için no kısmını boş bırakmasını formülle yapmışım makroyla yapabilirmiyiz o kısmada bir bakarsanız sevinirim. şimdiden kolay gelsin.

talatcd · 29 Haziran 2007

Dosya Ekte

talatcd · 29 Haziran 2007

Bordronunu çizilmiş halini elle çizmişim

Orion1 · 29 Haziran 2007

talatcd' Alıntı:
Bordronunu çizilmiş halini elle çizmişim

Aşağıdaki kodları denermisiniz.Galiba bu sefer oldu.

Kod:

Set s1 = Sheets("Parametre")
Set s2 = Sheets("Bordro")
s2.Select
Range("A2:O1000").Select 'Belirtilen hücre aralığını seç
Selection.ClearContents 'Belirtilen hücre aralığını sil
 Set s2 = Sheets("Bordro")
Sheets("Veri").Select 'Veri Sayfasını Seç
s2.[a1] = [b14].Text 'Veri Sayfasının B14 hücresini Bodro sayfasının A1 hücresine kayded
s2.[b2] = [a1].Text
s2.[c2] = [b1]
s2.[l3] = [b12]
s2.[n3] = [b13]
s2.[m2] = [a12]
s1.Select 'Parametre Sayfasını Seç
a = Array(1, 2, 4, 8, 9, 24, 11, 12, 13, 14, 15, 16, 17, 18)
sat = 3 'Üç satır boş bırak 4. satırdan başla
For x = 1 To [A65536].End(3).Row 'Paremetre sayfasının A sütunundan başla
    If Cells(x, 24) > 0 Then '24. sütun sıfırdan büyük ise ekle
        sat = sat + 1 'bir artarak say
        For y = 1 To 14 '14 sütun kopyala
            s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
        Next
    End If
Next x
a = Array(7, 8, 9, 10, 11, 12, 13, 14)
For y = 0 To 7
    s2.Cells(sat + 1, a(y)) = WorksheetFunction.Sum(Range(s2.Cells(8, a(y)), s2.Cells(sat, a(y))))
Next
SON_SATIR = s2.Cells(65536, "B").End(xlUp).Row
If SON_SATIR < 5 Then GoTo atla
For x = 1 To 4
s2.Range("A5:N" & SON_SATIR).Borders(x).LineStyle = 1
Next x
atla:
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "TOPLAM" 'En Son Satıra TOPLAM yazmak
Sheets("Bordro").Range("C65536").End(xlUp).Offset(4, 0).Value = Sheets("Veri").[A9]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(5, 0).Value = "Adı Soyadı    :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(2, 0).Value = Sheets("Veri").[B9]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "Ünvanı        :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B10]
Sheets("Bordro").Range("B65536").End(xlUp).Offset(1, 0).Value = "İmza          :"
Sheets("Bordro").Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B11]
Sheets("Bordro").Range("I65536").End(xlUp).Offset(3, 0).Value = Sheets("Veri").[A6]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(5, 0).Value = "Adı Soyadı    :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(5, 0).Value = Sheets("Veri").[B6]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(1, 0).Value = "Ünvanı        :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B7]
Sheets("Bordro").Range("H65536").End(xlUp).Offset(1, 0).Value = "İmza          :"
Sheets("Bordro").Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B8]

talatcd · 29 Haziran 2007

Saol Üstad ellerine sağlık tam istediğim gibi olmuş fakat, bordro hesaplarken çizgileri silip tekrar çizmesini nasıl sağlayabiliriz. personel azaldığı zaman sorun çıkıyor. çizgiler kalıyor.
Selection.ClearContents komutu yerine Selection.Delete yi kullandım fakat bundada hacre biçimi seçmem gereken yerler var sorun çıkarıyor.
Yani hücre çizgilerini silip tekrar çizdirebilirmiyiz.

zipir123 · 30 Haziran 2007

Sn. Talatcd dosyanızda belirtmiş oldugunuz isimler tc numaralarını ve banka hesaplarını birebir doğru vermişsiniz böyle bilgileri paylaşmanız ne kadar doğru !!!

Korhan Ayhan · 30 Haziran 2007

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Private Sub CommandButton1_Click() ' Belirli S&#252;tunlar&#305;n Aktar&#305;lmas&#305; ve Toplam Al&#305;nmas&#305;
    Set S1 = Sheets("Parametre")
    Set S2 = Sheets("Bordro")
    S2.Select
    S2.[A2:N65536].ClearContents 'Belirtilen h&#252;cre aral&#305;&#287;&#305;n&#305; sil
    Sheets("Veri").Select 'Veri Sayfas&#305;n&#305; Se&#231;
    S2.[a1] = [b14].Text 'Veri Sayfas&#305;n&#305;n B14 h&#252;cresini Bodro sayfas&#305;n&#305;n A1 h&#252;cresine kayded
    S2.[b2] = [a1].Text
    S2.[c2] = [b1]
    S2.[l3] = [b12]
    S2.[n3] = [b13]
    S2.[m2] = [a12]
    S1.Select 'Parametre Sayfas&#305;n&#305; Se&#231;
    a = Array(1, 2, 4, 8, 9, 24, 11, 12, 13, 14, 15, 16, 17, 18)
    sat = 3 '&#220;&#231; sat&#305;r bo&#351; b&#305;rak 4. sat&#305;rdan ba&#351;la
    For x = 1 To [A65536].End(3).Row 'Paremetre sayfas&#305;n&#305;n A s&#252;tunundan ba&#351;la
        If Cells(x, 24) > 0 Then '24. s&#252;tun s&#305;f&#305;rdan b&#252;y&#252;k ise ekle
            sat = sat + 1 'bir artarak say
            For y = 1 To 14 '14 s&#252;tun kopyala
                S2.Cells(sat, y) = S1.Cells(x, a(y - 1))
            Next
        End If
    Next x
    a = Array(7, 8, 9, 10, 11, 12, 13, 14)
    For y = 0 To 7
        S2.Cells(sat + 1, a(y)) = WorksheetFunction.Sum(Range(S2.Cells(8, a(y)), S2.Cells(sat, a(y))))
    Next
    
    With S2.[A4:N65536]
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    SON_SATIR = S2.[A65536].End(3).Row + 1
    ADRES = Range("A4:N" & SON_SATIR).Address
    With S2.Range(ADRES)
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlEdgeBottom).Weight = xlThin
    .Borders(xlEdgeRight).Weight = xlThin
    .Borders(xlInsideVertical).Weight = xlThin
    .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    
    S2.Range("B65536").End(xlUp).Offset(1, 0).Value = "TOPLAM" 'En Son Sat&#305;ra TOPLAM yazmak
    S2.Range("C65536").End(xlUp).Offset(4, 0).Value = Sheets("Veri").[A9]
    S2.Range("B65536").End(xlUp).Offset(5, 0).Value = "Ad&#305; Soyad&#305;    :"
    S2.Range("C65536").End(xlUp).Offset(2, 0).Value = Sheets("Veri").[B9]
    S2.Range("B65536").End(xlUp).Offset(1, 0).Value = "&#220;nvan&#305;        :"
    S2.Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B10]
    S2.Range("B65536").End(xlUp).Offset(1, 0).Value = "&#304;mza          :"
    S2.Range("C65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B11]
    S2.Range("I65536").End(xlUp).Offset(3, 0).Value = Sheets("Veri").[A6]
    S2.Range("H65536").End(xlUp).Offset(5, 0).Value = "Ad&#305; Soyad&#305;    :"
    S2.Range("J65536").End(xlUp).Offset(5, 0).Value = Sheets("Veri").[B6]
    S2.Range("H65536").End(xlUp).Offset(1, 0).Value = "&#220;nvan&#305;        :"
    S2.Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B7]
    S2.Range("H65536").End(xlUp).Offset(1, 0).Value = "&#304;mza          :"
    S2.Range("J65536").End(xlUp).Offset(1, 0).Value = Sheets("Veri").[B8]
End Sub

talatcd · 1 Temmuz 2007

üstadlarım ellerinize sağlık tam istediğim gibi olmuş. allah yar ve yardımcınız olsun.

Listede Çizim

talatcd

Orion1

Uzman

talatcd

talatcd

Orion1

Uzman

talatcd

Orion1

Uzman

Korhan Ayhan

Administrator

talatcd

talatcd

talatcd

Orion1

Uzman

talatcd

zipir123

Korhan Ayhan

Administrator

talatcd