Senet yazdırma sayfası


VBA yardımıyla bir M.S. Word dosyasının senet yazdırı olarak kullanılmasına imkan tanınmıştır. Uygulamada butonlar haricinde bir ocx nesnesi kullanılmamıştır. Verilerin M.S. Word metin kutularıında görüntülenmesi sağlanmıştır ki bu nesneler TextBox nesneleri değildir bu nedenle de verilerin akarımı yapılırken TextFrame.TextRange özelliği kullanılmıştır. Uygulamanın kodları aşağıdaki gibidir, kullanıcılara faydalı olması dileğiyle.

Kaynak Kodlar:

Private  Sub  btnUygKapat_Click()  
       Application.DisplayAlerts  =  wdAlertsNone  
       Application.Quit  SaveChanges:=False  
End  Sub  

Private  Sub  btnYazdir_Click()  
UserForm1.Show  
'Dim i As Integer
'For i = 1 To ThisDocument.Shapes.Count
' On Error Resume Next
' ThisDocument.Shapes(i).TextFrame.TextRange.Text = i
'Next
End  Sub  

Private  Sub  Document_Open()  
       Dim  i  As  Integer  
       For  i  =  1  To  ThisDocument.Shapes.Count  
               On  Error  Resume  Next  
               ThisDocument.Shapes(i).TextFrame.TextRange.Text  =  ""  
       Next  
       With  ThisDocument  
               .btnYazdir.Width  =  72  
               .btnYazdir.Height  =  24  
               .btnUygKapat.Width  =  72  
               .btnUygKapat.Height  =  24  
       End  With  
End  Sub  
'USER FORM EKLENEREK ASAGIDA VERILEN KODLAR YAZILMALIDIR
Private  Sub  btnCikis_Click()  
       With  ThisDocument  
               .btnYazdir.Width  =  72  
               .btnYazdir.Height  =  24  
               .btnUygKapat.Width  =  72  
               .btnUygKapat.Height  =  24  
       End  With  
       Unload  Me  
End  Sub  

Private  Sub  btnTamam_Click()  
Dim  i  As  Integer,  tarih  As  Date,  bekle    As  Variant  

If  kontrol  =  True  Then  
'ilk senet tarihi aliniyor
tarih  =  txtKiraTarihi.Text  
For  i  =  1  To  Val(txtVade.Text)  
       If  WeekdayName(Weekday(tarih  -  1))  =  "Cumartesi"  Then  
               tarih  =  tarih  +  2  
       ElseIf  WeekdayName(Weekday(tarih  -  1))  =  "Pazar"  Then  
               tarih  =  tarih  +  1  
       End  If  
       With  ThisDocument  
               .Shapes(1).TextFrame.TextRange.Text  =  txtVade.Text  
               .Shapes(2).TextFrame.TextRange.Text  =  tarih  'txtKiraTarihi.Text 
               .Shapes(3).TextFrame.TextRange.Text  =  Trim("#")  &  txtTutar.Text  &  Trim("#")  
               .Shapes(13).TextFrame.TextRange.Text  =  Trim("#")  &  txtTutar.Text  &  Trim("#")  
               .Shapes(4).TextFrame.TextRange.Text  =  Trim("#")  &  txtKurus.Text  &  Trim("#")  
               .Shapes(14).TextFrame.TextRange.Text  =  Trim("#")  &  txtKurus.Text  &  Trim("#")  
               .Shapes(5).TextFrame.TextRange.Text  =  i  
               .Shapes(6).TextFrame.TextRange.Text  =  txtAdi.Text  
               .Shapes(7).TextFrame.TextRange.Text  =  tarih  
               .Shapes(8).TextFrame.TextRange.Text  =  txtAdi.Text  
               .Shapes(9).TextFrame.TextRange.Text  =  txtTC.Text  
               .Shapes(11).TextFrame.TextRange.Text  =  txtDuzenlemeTarihi.Text  
       End  With  
       'bir sonraki senet icin tarih arttiriliyor 
       tarih  =  tarih  +  30  
       'belge yazdiriliyor 
       ThisDocument.PrintOut  
       'sonra 5 saniye bekleme yapiliyor 
       bekle  =  Timer  
       Do  
               DoEvents  
       Loop  Until  Timer  >  bekle  +  5  
Next  
MsgBox  "Senet  yazdirma  işlemi  tamamlandi",  vbInformation  +  vbOKOnly,  "Bilgi"  
       With  ThisDocument  
               .btnYazdir.Width  =  72  
               .btnYazdir.Height  =  24  
               .btnUygKapat.Width  =  72  
               .btnUygKapat.Height  =  24  
       End  With  
Unload  Me  
End  If  
End  Sub  

Private  Sub  UserForm_Initialize()  
       With  ThisDocument  
               .btnYazdir.Width  =  0  
               .btnYazdir.Height  =  0  
               .btnUygKapat.Width  =  0  
               .btnUygKapat.Height  =  0  
       End  With  
       txtKurus.Text  =  "0"  
       txtVade.Text  =  "12"  
       txtDuzenlemeTarihi.Text  =  Format(Now,  "dd/mm/yyyy")  
       txtKiraTarihi.Text  =  Format(Now,  "dd/mm/yyyy")  
End  Sub  
Function  kontrol()  As  Boolean  
'********************************************************************************************************
'Kodlama : Bilal SERT
'Tarih/Saat : 14.01.2019
'G/Ç :-
'Çağrıldığı yer : btnTamam.click()
'Çağırdıkları : -
'********************************************************************************************************
If  txtTC.Text  =  ""  Then  
       MsgBox  "T.C.  kimlik  no  alani  bos  bırakılamaz",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  Len(txtTC.Text)  <>  11  Then  
       MsgBox  "T.C.  kimlik  no    11  basamaklı  olmalıdır",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  Not  IsNumeric(txtTC.Text)  Then  
       MsgBox  "T.C.  kimlik  no    sadece  sayilardan  olusmalıdır",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  txtAdi.Text  =  ""  Then  
       MsgBox  "Borçlunun  adı  boş  bırakılamaz",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  txtKiraTarihi.Text  =  ""  Then  
       MsgBox  "Kira  tarihi  boş  bırakılamaz",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  txtDuzenlemeTarihi.Text  =  ""  Then  
       MsgBox  "Senet  düzenleme  tarihi  boş  bırakılamaz",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  Not  IsNumeric(txtKurus.Text)  Then  
       MsgBox  "Kuruş  sadece  sayilardan  olusmalıdır",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  Not  IsNumeric(txtTutar.Text)  Then  
       MsgBox  "Kira  tutarı  sadece  sayilardan  olusmalıdır",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
ElseIf  Not  IsNumeric(txtVade.Text)  Then  
       MsgBox  "Vade  sadece  sayilardan  olusmalıdır",  vbCritical  +  vbOKOnly,  "Dikkat!"  
       kontrol  =  False  
       Exit  Function  
End  If  
kontrol  =  True  
End  Function