Skip to main content

AccessTr.neT


Worde Butonla Resim Aktarmak

Worde Butonla Resim Aktarmak

Çözüldü #1
Arkadaşlar merhaba, sistemimde pbif formu mevcut. Bu formun muayene sekmesinde "Psikotenik Muayene Formu" butonuna basınca o andaki personel bilgilerine göre worde veri aktarıyor. Buraya kadar hepsi güzel çalışıyor. Benim sorum acaba bu verilerle beraber personel resmini de aktarabilir miyim ?  Icon_rolleyes Teşekkürler.
.rar RVS MDB 05.11.2015 yönetim modülü.rar (Dosya Boyutu: 1,42 MB | İndirme Sayısı: 12)
Cevapla
#2
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.
.rar RVS MDB albüm.rar (Dosya Boyutu: 4 MB | İndirme Sayısı: 9)
Cevapla
#3
Sayın Akiff,

Resim ekleme işlemi gördüğüm kadarıyla hatalı, resim bilgisi tabloya "C:\Users\Guest\Downloads\resimler\ornek.jpg" şeklinde kaydedilmemeli, sadece resim adı ornek.jpg kaydedilmelidir.
Vba sayfasında resim currentproject.path & "\resim\" & resimadi şeklinde çağırmalısınız.

Uygulamayı inceleyip olumlu olumsuz bildirimde bulununuz.
.rar RVS MDB albüm_sld.rar (Dosya Boyutu: 683,62 KB | İndirme Sayısı: 38)
Cevapla
#4
Çok sağ olun hocam tam istediğim gibi, ben kayıt yaparken o kısmı hiç aklıma gelmedi. Teşşekürler.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task