Merhaba,
Yeni modül oluştur ve aşağıdaki kodları modüle ekle. Modülü kaydet.
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1 'Open Normal
Public Const WIN_MAX = 3 'Open Maximized
Public Const WIN_MIN = 2 'Open Minimized
'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
'****************************************************
Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
'First try ShellExecute
lRet = apiShellExecute(hWndAccessApp, vbNullString, _
stFile, vbNullString, vbNullString, lShowHow)
If lRet > ERROR_SUCCESS Then
stRet = vbNullString
lRet = -1
Else
Select Case lRet
Case ERROR_NO_ASSOC:
'Try the OpenWith dialog
varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
& stFile, WIN_NORMAL)
lRet = (varTaskID <> 0)
Case ERROR_OUT_OF_MEM:
stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
Case ERROR_FILE_NOT_FOUND:
stRet = "Error: File not found. Couldn't Execute!"
Case ERROR_PATH_NOT_FOUND:
stRet = "Error: Path not found. Couldn't Execute!"
Case ERROR_BAD_FORMAT:
stRet = "Error: Bad File Format. Couldn't Execute!"
Case Else:
End Select
End If
fHandleFile = lRet & _
IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********
Komut29'un tıklandığında olayındaki kodu aşağıdaki ile değiştir.
'Eksik alan ve kaydedilmemiş kayıt kontrolü.
If IsNull(bankaak) Then
MsgBox "Banka Adı Boş Olamaz!"
Me.bankaak.SetFocus
Exit Sub
End If
If IsNull(subeak) Then
MsgBox "Şube Adı Boş Olamaz!"
Me.subeak.SetFocus
Exit Sub
End If
If IsNull(hesapno) Then
MsgBox "Hesap numarası boş olamaz!"
Me.hesapno.SetFocus
Exit Sub
End If
If IsNull(hesapadi) Then
MsgBox "Hesap Adı Boş olamaz!"
Me.hesapadi.SetFocus
Exit Sub
End If
If IsNull(SayiRakkamla) Then
MsgBox "Tutar boş olamaz!"
Me.SayiRakkamla.SetFocus
Exit Sub
End If
If IsNull(yaziylatutar) Then
MsgBox "Tutar Boş olamaz!"
Me.yaziylatutar.SetFocus
Exit Sub
End If
If IsNull(aliciadi) Then
MsgBox "Alıcı Adı Boş olamaz!"
Me.aliciadi.SetFocus
Exit Sub
End If
If IsNull(alicibankaadi) Then
MsgBox "Alıcı Banka Adı Boş olamaz!"
Me.alicibankaadi.SetFocus
Exit Sub
End If
If IsNull(alicisubeadi) Then
MsgBox "Alıcı Şube Adı Boş olamaz!"
Me.alicisubeadi.SetFocus
Exit Sub
End If
If MsgBox("HATIRLATMA.. " & Chr(13) & _
"Yazdırılacak!", 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 & "\efttalimat.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:="bankaak"
.TypeText [bankaak].Column(1)
.GoTo what:=wdGoToBookmark, Name:="subeak"
.TypeText [subeak].Column(1)
.GoTo what:=wdGoToBookmark, Name:="hesapno"
.TypeText [hesapno].Column(2)
.GoTo what:=wdGoToBookmark, Name:="hesapadi"
.TypeText [hesapadi].Column(2)
.GoTo what:=wdGoToBookmark, Name:="SayiRakkamla"
.TypeText [SayiRakkamla]
.GoTo what:=wdGoToBookmark, Name:="yaziylatutar"
.TypeText [yaziylatutar]
.GoTo what:=wdGoToBookmark, Name:="aliciadi"
.TypeText [aliciadi]
.GoTo what:=wdGoToBookmark, Name:="alicibankaadi"
.TypeText [alicibankaadi]
.GoTo what:=wdGoToBookmark, Name:="alicisubeadi"
.TypeText [alicisubeadi]
.GoTo what:=wdGoToBookmark, Name:="alicihesapno"
.TypeText [alicihesapno]
.GoTo what:=wdGoToBookmark, Name:="aliciibanno"
.TypeText [aliciibanno]
.GoTo what:=wdGoToBookmark, Name:="aciklama"
.TypeText [aciklama]
.GoTo what:=wdGoToBookmark, Name:="tcvergino"
.TypeText [tcvergino]
.GoTo what:=wdGoToBookmark, Name:="tarih"
.TypeText [tarih]
End With
Dim BelgeAdi, BelgeYolu As String
BelgeAdi = aliciadi & "-" & Date & ".docx"
BelgeYolu = CurrentProject.Path & "\" & 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
