Aktarma,Yeni Kayıt ve Raporda hata

[Ercan_ÇELİKOĞLU]

Küçük bir soru daha ödeme emri belgesine bağlantı kurulabilirmi?

 

[hsayar]

pardon Sheets.Banka_Listesi Raporlama da 61 kişi yerine 62 kişi yazıyor tek hata o Şu anda

WrdBnkList modulünde ağaşğıdaki satrı

    kisi = WorksheetFunction.CountIf(Range("[B]B3:B[/B]" & SnDlSt), "<>""")

bununla değiştriniz.

    kisi = WorksheetFunction.CountIf(Range("[B]B4:B[/B]" & SnDlSt), "<>""")

 

[hsayar]

Küçük bir soru daha ödeme emri belgesine bağlantı kurulabilirmi?

ödemeemri!z10 hücresine ücret bordrosu toplamını mı yazdırmak istiyorsunuz?

eğer öyle ise
WrdUcrBrd modulünü

Sub UcrBrdWrd()
Application.ScreenUpdating = True
Call SayfaGoster
    Dim buWb As Workbook
    Dim YnWb As Workbook
    Dim ShOny As Worksheet
    Dim SnDlSt As Integer
    Dim objword As Object
    Set buWb = ThisWorkbook
    Set ShOny = Sheets("personel")
    Dim s2 As Worksheet
    Set s2 = ThisWorkbook.Worksheets("Bilgi_Girisi")
    Dim shUB As Worksheet
    Set shUB = buWb.Worksheets("Ucret_Bodrosu")
    Dim shOE As Worksheet
    Set shOE = buWb.Worksheets("ÖDEME EMRİ")
    
    shUB.Select

    
    SnDlSt = [k65536].End(3).Row    '55
    '+1 Toplam , +3 yazıyla, +5 onayisim +6 onay soyad +7 ünvan
    'MsgBox SnDlSt
    
    Range("A1:K" & SnDlSt).Select: Selection.Copy
    Set YnWb = Workbooks.Add: ActiveSheet.Paste
    Columns("A:K").Select
    Range("A2").Activate
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    'Son Dolu satırın bir altına toplam al ve toplam yaz
    Cells(SnDlSt + 1, "H").Value = WorksheetFunction.Sum(Range("H7:H" & SnDlSt))
    Cells(SnDlSt + 1, "H").NumberFormat = "#,##0.00"
    Cells(SnDlSt + 1, "I").Value = WorksheetFunction.Sum(Range("I7:I" & SnDlSt))
    Cells(SnDlSt + 1, "I").NumberFormat = "#,##0.00"
    Cells(SnDlSt + 1, "B").Value = "T  O  P  L  A  M"
    'b:g aralığını birleştir, biçimlendir
    Range("B" & SnDlSt + 1 & ":G" & SnDlSt + 1).Select
    Selection.Merge
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlDistributed
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    'a:k aralığına kenarlkık koy
    Range("A5:K" & SnDlSt + 1).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    Range("B" & SnDlSt + 3 & ":K" & SnDlSt + 3).Select
    Selection.Merge
    Selection.HorizontalAlignment = xlLeft
    Range("B" & SnDlSt + 5 & ":D" & SnDlSt + 7).Select
    Selection.Merge
    Range("E" & SnDlSt + 5 & ":G" & SnDlSt + 7).Select
    Selection.Merge
    Range("H" & SnDlSt + 5 & ":J" & SnDlSt + 7).Select
    Selection.Merge
    
    ODEME = Format(Cells(SnDlSt + 1, "I").Value, "#,##0.00")
    kisi = WorksheetFunction.CountIf(Range("B7:B" & SnDlSt), "<>""")
    Range("B" & SnDlSt + 3).Value = kisi & "(" & ParaCevir(kisi, "", "") & ") ki&#351;iye toplam " & _
                                    ODEME & "(" & ParaCevir(ODEME, "YTL", "YKR") & ") tahakkuk etmi&#351;tir."
    Range("B" & SnDlSt + 5).Value = "Haz&#305;rlayan" & vbLf & ShOny.Range("b2") & " " & ShOny.Range("c2") & vbLf & ShOny.Range("d2")
    Range("E" & SnDlSt + 5).Value = "Ger&#231;ekle&#351;tirme G&#246;revlisi" & vbLf & ShOny.Range("b3") & " " & ShOny.Range("c3") & vbLf & ShOny.Range("d3")
    Range("H" & SnDlSt + 5).Value = "Harcama Yetkilisi" & vbLf & ShOny.Range("b4") & " " & ShOny.Range("c4") & vbLf & ShOny.Range("d4")
    
    YnWb.Sheets(1).Range("A1:K" & 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 = 56.7
        .RightMargin = 56.7
        .PageWidth = 841.95 'CentimetersToPoints(29.7)
        .PageHeight = 595.35 'CentimetersToPoints(21)
      End With

    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
    YnWb.Close False
    Range("a1").Select
    
    shOE.Select
    Range("Z10") = ODEME * 1
    s2.Select
    
    
    'Format(Cells(SnDlSt + 1, "I").Value, "#,##0.00")
Call SayfaGizle
Application.ScreenUpdating = False
End Sub

değiştiriniz

 

[Ercan_ÇELİKOĞLU]

daha diyecek bir sözüm yok çok ama çok sağolun şimdi daha önce fpc tarafından hazırlanan ama tam olarak çalışmayan nakdi yardım programı kaldı oda çözülse daha allahtan başka bir şey istemem!

 

[hsayar]

Rica ederim Allah (c.c.) cümlemizden razı olsun...
yalnız daha evvelde belirttiğim gibi... biraz da siz uğraşsanız fena olmaz...
Sizin durumunuz ellame veriir talkımı kendi yutar salkımı durumuyla aynı...
sn. fpc nin programında ne eksiklik gördünüz

 

[Ercan_ÇELİKOĞLU]

yeni konu olarak açmayı düşünüyorum müsadenizle tabiki ben uğraşmayı isterim ah bir kodlar nerden nasıl yazılıyor anlasam????
yani visual basice giriyorum ama kodlar nasıl yazılıyor bilmiyorum

 

[Ercan_ÇELİKOĞLU]

Tam sevinmişken her şey yolunda diyorken

Sheets Banka_Listesi
Sheets Ay_Listesi
Raporla butonuna basınca rapor vermiyor
(S.O.S)<<<iMDAAAAAAAAT

 

[Ercan_ÇELİKOĞLU]

Sayın hsayar bu aksilikler ne zaman bitecek?

 

[hsayar]

Siz &#214;nce AKTAR Tu&#351;una Basmay&#305; akl&#305;n&#305;za getirdi&#287;inizde

 

[Ercan_ÇELİKOĞLU]

Ben Önce Aktara Basiyorum

Siz Önce AKTAR Tuşuna Basmayı aklınıza getirdiğinizde

'ücret bodrosu
For i = 3 To s2.Cells(65536, 2).End(xlUp).Row
s3.Range("b65536").End(xlUp).Offset(1, -1).Value = i - 2 & ".)"
s3.Range("b65536").End(xlUp).Offset(1, -1).HorizontalAlignment = xlRight
s3.Range("b65536").End(xlUp).Offset(1, -1).Font.Bold = True
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeLeft).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeTop).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeBottom).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeRight).LineStyle = xlContinuous
s2.Range("c" & i & ":f" & i).Copy
s3.Range("b65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
s2.Range("n" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 4).PasteSpecial xlPasteAll
s2.Range("o" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 5).PasteSpecial xlPasteAll
s2.Range("Q" & i & ":T" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 6).PasteSpecial xlPasteAll
Next i
BURASI DEBUG VERİYOR
( s3.Select
Range("A7:K" & s3.Cells(65536, "k").End(xlUp).Row).Select
Selection.Font.Bold = False )

 

[hsayar]

Bende &#246;nce aktara bast&#305;m ard&#305;ndan raporla da dedi&#287;iniz yerlere ben hata alomad&#305;m ama tekrar kontrol edelim

 

[hsayar]

Hatanan&#305;n sebebi gizlenmi&#351; sayfaya vban&#305;n ula&#351;maya &#231;al&#305;&#351;mas&#305;
De&#287;i&#351;tiriniz...

Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
[COLOR=RED] Call SayfaGoster[/COLOR]
Call Exc_Tem
Dim say As Long, say1 As Long, say3 As Long
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet, s4 As Worksheet
Dim ADOSYA As String
ADOSYA = ThisWorkbook.Name
Windows(ADOSYA).Activate
Set s1 = ThisWorkbook.Worksheets("veri")
Set s2 = ThisWorkbook.Worksheets("Bilgi_Girisi")
Set s3 = ThisWorkbook.Worksheets("Ucret_Bodrosu")
Set s4 = ThisWorkbook.Worksheets("Ay_Listesi")
Set s5 = ThisWorkbook.Worksheets("Banka_Listesi")
 s1.Range("b65536").End(xlUp).Offset(1, 0).Value = ComboBox1
say = s3.Cells(65536, 2).End(xlUp).Row
s3.Range("B7:Z" & say + 7).ClearContents
say1 = s4.Cells(65536, 2).End(xlUp).Row
s4.Range("B5:Z" & say + 7).ClearContents
say2 = s5.Cells(65536, 2).End(xlUp).Row
s5.Range("B3:Z" & say + 7).ClearContents

'ücret bodrosu
For i = 3 To s2.Cells(65536, 2).End(xlUp).Row
s3.Range("b65536").End(xlUp).Offset(1, -1).Value = i - 2 & ".)"
s3.Range("b65536").End(xlUp).Offset(1, -1).HorizontalAlignment = xlRight
s3.Range("b65536").End(xlUp).Offset(1, -1).Font.Bold = True
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeLeft).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeTop).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeBottom).LineStyle = xlContinuous
s3.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeRight).LineStyle = xlContinuous
s2.Range("c" & i & ":f" & i).Copy
s3.Range("b65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
s2.Range("n" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 4).PasteSpecial xlPasteAll
s2.Range("o" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 5).PasteSpecial xlPasteAll
s2.Range("Q" & i & ":T" & i).Copy
s3.Range("b65536").End(xlUp).Offset(0, 6).PasteSpecial xlPasteAll
Next i
    s3.Select
    Range("A7:K" & s3.Cells(65536, "k").End(xlUp).Row).Select
    Selection.Font.Bold = False





'Ay_Listesi
For i = 3 To s2.Cells(65536, 2).End(xlUp).Row
s4.Range("b65536").End(xlUp).Offset(1, -1).Value = i - 2 & ".)"
s4.Range("b65536").End(xlUp).Offset(1, -1).HorizontalAlignment = xlRight
s4.Range("b65536").End(xlUp).Offset(1, -1).Font.Bold = True
s4.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeLeft).LineStyle = xlContinuous
s4.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeTop).LineStyle = xlContinuous
s4.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeBottom).LineStyle = xlContinuous
s4.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeRight).LineStyle = xlContinuous
s2.Range("C" & i & ":L" & i).Copy
s4.Range("b65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
s2.Range("R" & i).Copy
s4.Range("b65536").End(xlUp).Offset(0, 10).PasteSpecial xlPasteAll
Next i
    s4.Select
    Range("A5:L" & s4.Cells(65536, "L").End(xlUp).Row).Select
    Selection.Font.Bold = False



'Banka_Listesi
s5.Range("A3").Value = "Sr No"
s5.Range("B3").Value = "ADI"
s5.Range("c3").Value = "SOYADI"
s5.Range("d3").Value = "Ödenecek Ay"
s5.Range("e3").Value = "Ödenecek Miktar"
s5.Range("f3").Value = "Banka Kodu"
s5.Range("g3").Value = "Hesap No"

sno = 0
For i = 3 To s2.Cells(65536, 2).End(xlUp).Row

s5.Range("b65536").End(xlUp).Offset(1, -1).Value = i - 2 & ".)"
s5.Range("b65536").End(xlUp).Offset(1, -1).HorizontalAlignment = xlRight
s5.Range("b65536").End(xlUp).Offset(1, -1).Font.Bold = True
s5.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeLeft).LineStyle = xlContinuous
s5.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeTop).LineStyle = xlContinuous
s5.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeBottom).LineStyle = xlContinuous
s5.Range("b65536").End(xlUp).Offset(1, -1).Borders(xlEdgeRight).LineStyle = xlContinuous
s2.Range("E" & i & ":F" & i).Copy
s5.Range("b65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
s2.Range("P" & i).Copy
s5.Range("b65536").End(xlUp).Offset(0, 2).PasteSpecial xlPasteAll
s2.Range("R" & i).Copy
s5.Range("b65536").End(xlUp).Offset(0, 3).PasteSpecial xlPasteAll
s2.Range("M" & i & ":N" & i).Copy
s5.Range("b65536").End(xlUp).Offset(0, 4).PasteSpecial xlPasteAll
Next i
    s5.Select
    Range("A4:G" & s5.Cells(65536, "G").End(xlUp).Row).Select
    Selection.Font.Bold = False

MsgBox "Aktarma Tamamlandı"
[COLOR=RED] [B]Call SayfaGizle[/B] [/COLOR]
Application.ScreenUpdating = True
End Sub

 

[Ercan_ÇELİKOĞLU]

Say&#305;n hsayar ;
Mucizeler u&#287;rarm&#305;&#351; bizim buralara diyorum.
te&#351;ekk&#252;r&#252; tekrar bir bor&#231; biliyorum sayg&#305;lar&#305;m&#305; sunar&#305;m. sa&#287;olun hemde &#199;OOOOOK ama &#199;OOOOOOOOOOOOOOOOOOOOOK.
(Bide nakdi yard&#305;m program&#305; gerekirse ba&#351;tan bir dizayn denensin yeterki oda g&#252;zel bi&#351;ey olsun)

 

[assenucler]

Rica.

Sn. harbiyigit,


Günaydın. Sizden isteğim, dosyanın son halini siteye yüklemeniz. Teşekkürler.

 

[Ercan_ÇELİKOĞLU]

Memnuniyetle

Sn. harbiyigit,


Günaydın. Sizden isteğim, dosyanın son halini siteye yüklemeniz. Teşekkürler.

Sayın assenucler. Dosyanın son hali eklenmiştir.
Ayrıca Sayın hsayar size çok büyük bir teşekkürü borç bilirim yaptığınız işin arkasında durduğunuz için saygılar.