Kod:
Private Sub Komut67_Click()
'Eksik alan ve kaydedilmemiş kayıt kontrolü.
If IsNull(firma_adi) Then
MsgBox "Firma Adı Boş Olamaz!"
Me.firma_adi.SetFocus
Exit Sub
End If
If MsgBox("HATIRLATMA.. " & Chr(13) & _
"Bilgileri Doğru Yazdığına Eminmisin", vbInformation + vbOKCancel) = vbOK Then
Else
Exit Sub
End If
' Word Şablonundan yeni belge oluşturma.
Dim WordApp As Word.Application
Dim strTemplateLocation As String
' Şablonun bulunduğu yer
strTemplateLocation = CurrentProject.Path & "\origins" & "\taslak.docx"
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
' On Error GoTo ErrHandler
WordApp.Visible = False
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
' Her satırı uygun olan kayıt ile değiştirmek.
With WordApp.Selection
.GoTo what:=wdGoToBookmark, Name:="firma_adi"
.TypeText [firma_adi]
.GoTo what:=wdGoToBookmark, Name:="urun_adi"
.TypeText [urun_adi]
.GoTo what:=wdGoToBookmark, Name:="fiyati"
.TypeText [fiyati]
.GoTo what:=wdGoToBookmark, Name:="odeme_sekli"
.TypeText [odeme_sekli]
.GoTo what:=wdGoToBookmark, Name:="vade"
.TypeText [vade]
.GoTo what:=wdGoToBookmark, Name:="fatura"
.TypeText [fatura]
.GoTo what:=wdGoToBookmark, Name:="ilgili_kisi"
.TypeText [ilgili_kisi]
.GoTo what:=wdGoToBookmark, Name:="telefon"
.TypeText [telefon]
.GoTo what:=wdGoToBookmark, Name:="anlasmayi_yapan"
.TypeText [anlasmayi_yapan]
End With
Dim BelgeAdi, BelgeYolu As String
BelgeAdi = firma_adi & "-" & Date & ".docx"
BelgeYolu = CurrentProject.Path & "\arşiv" & "\" & BelgeAdi
WordApp.ActiveDocument.SaveAs BelgeYolu ', wdFormatDocument
WordApp.Application.Quit
If MsgBox(BelgeAdi & " isimli belge oluşturuldu. Dosya Açılsın mı?", vbInformation + vbYesNo, "Belge Aç") = vbYes Then
Call fHandleFile(BelgeYolu, WIN_NORMAL)
End If
' DoEvents
' WordApp.Activate
Set WordApp = Nothing
' Exit Sub
'ErrHandler:
Set WordApp = Nothing
End Sub