Sanırım konuyu gören olmamış, konu hakkında yaptığım çalışmalar aşağıdaki gibi.
Önce internet üzerinde yaptığın araştırma sonucu sitede yapılan bir çalışma mevcut.
link Bu kodlarla benim sistemimde word de yer işareti olan kısımlara veri aktarımını birleştirmeye çalıştım. Fakat çok başarılı olamadım. Kodlama aşağıdaki şekilde yapıldı.
Kod:
If IsNull(ad) Then
MsgBox "Lütfen Ad Giriniz"
Me.ad.SetFocus
Exit Sub
End If
If IsNull(soyad) Then
MsgBox "Lütfen soyad Giriniz"
Me.soyad.SetFocus
Exit Sub
End If
If IsNull(tc) Then
MsgBox "Lütfen Tc Numarasını Giriniz"
Me.tc.SetFocus
Exit Sub
End If
If IsNull(dogumyer) Then
MsgBox "Lütfen Doğum Yerini Giriniz"
Me.dogumyer.SetFocus
Exit Sub
End If
If IsNull(dogumtar) Then
MsgBox "Lütfen Doğum Tarihini Giriniz"
Me.dogumtar.SetFocus
Exit Sub
End If
If IsNull(giristar) Then
MsgBox "Lütfen İşe Giriş Tarihini Giriniz"
Me.giristar.SetFocus
Exit Sub
End If
If IsNull(gorev) Then
MsgBox "Lütfen Görevi Giriniz"
Me.gorev.SetFocus
Exit Sub
End If
If IsNull(simdi) Then
MsgBox "Güncel Tarih Hatası"
Me.[simdi].SetFocus
Exit Sub
End If
If IsNull(medenidrm) Then
MsgBox "Lütfen Medeni Durum Giriniz"
Me.[medenidrm].SetFocus
Exit Sub
End If
If MsgBox("D İ K K A T" & Chr(13) & _
"Bilgiler Şablona Yazdırılacak. Onaylıyor musunuz?", vbInformation + vbOKCancel) = vbOK Then
Else
Exit Sub
End If
Dim WordApp As Word.Application
Dim strTemplateLocation As String
strTemplateLocation = CurrentProject.Path & "/psikoteknikformu.dot"
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 = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
' Word belgemizdeki Yer İmleri ile formdaki alanları eşitleyip yer imlerini uygun kayıtlarla değiştireceğimiz kodlar başlıyor.
With WordApp.Selection
If IsNull(ad) Then
.GoTo what:=wdGoToBookmark, Name:="Ad"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="Ad"
.TypeText [ad]
End If
If IsNull(soyad) Then
.GoTo what:=wdGoToBookmark, Name:="Soyad"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="Soyad"
.TypeText [soyad]
End If
If IsNull(tc) Then
.GoTo what:=wdGoToBookmark, Name:="tc"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="tc"
.TypeText [tc]
End If
If IsNull(medenidrm) Then
.GoTo what:=wdGoToBookmark, Name:="medenidurum"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="medenidurum"
.TypeText [medenidrm]
End If
If IsNull(dogumtar) Then
.GoTo what:=wdGoToBookmark, Name:="Dogumtarihi"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="Dogumtarihi"
.TypeText [dogumtar]
End If
If IsNull(dogumyer) Then
.GoTo what:=wdGoToBookmark, Name:="dogumyeri"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="dogumyeri"
.TypeText [dogumyer]
End If
If IsNull(simdi) Then
.GoTo what:=wdGoToBookmark, Name:="tarih"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="tarih"
.TypeText [simdi]
End If
If IsNull(gorev) Then
.GoTo what:=wdGoToBookmark, Name:="gorev"
.TypeText ""
Else
.GoTo what:=wdGoToBookmark, Name:="gorev"
.TypeText [gorev]
End If
.GoTo what:=wdGoToBookmark, Name:="resim"
.InlineShapes.AddPicture (Me.resim & ".jpg")
End With
DoEvents
WordApp.Activate
Set WordApp = Nothing
Exit Sub
ErrHandler:
Set WordApp = Nothing
End Sub
Aslında linkteki örnek çalışıyor. Fakat bu typein olarak yapılmış yani yer işaretlerine göre değil sırayla yazıları yazıyor veya liste oluşturuyor. Resimleri de sırayla lat alta rasgele koyuyor. Benim istediğim PBİF formunda "muayene" sekmesinde Psikoteknik Muayene butonuna basınca yazılı olan bilgilerle beraber personelin resminide kutunun içine atması. Bunu Yapmak mümkün müdür acaba? Teşekkürler.
RVS MDB albüm.rar
(Dosya Boyutu: 4 MB | İndirme Sayısı: 9)
Teşekkürler.
#1
