Uygulamanızın son halini ekleyin.
Formdan Word Dosyasına Aktarma Sorunu
Uygulamayı ekledim.İlk kayıtta bütün bilgiler ve 4 farklı resim var.Diğer kayıtlarda ise karşılaştığım sorunları gösterecek şekildedir.Teşekkürler.
olay.rar
(Dosya Boyutu: 377,47 KB | İndirme Sayısı: 4)
Butonun tıklandığında olayındaki kodun tamamını aşağıdaki ile değiştir.
Dim BelgeAcik As Boolean
Dim ResimBilgisi As Variant
Dim ResimAdi As String
Dim Kayit As DAO.Recordset
'Dim Sorgum As QueryDef
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WordDocYeni As Word.Document
Dim GSablon, GKlasor, GDosyaNo, GDosyaYolu As String
Dim AcikBelgeResim
Dim GeciciPersonelDosyasi, GeciciBelgeAdi As String
GKlasor = Environ("TEMP")
GDosyaNo = Format(Now(), "ddmmyyyyhhnnss")
GDosyaYolu = GKlasor & "\AccessTrneT" & GDosyaNo & "\"
GSablon = CurrentProject.Path & "\format1.docx"
If FolderExists(GDosyaYolu) = False Then
MkDir GDosyaYolu
End If
' Set Sorgum = CurrentDb.QueryDefs("kbsorgu")
' Set Kayit = Sorgum.OpenRecordset()
Set Kayit = CurrentDb.OpenRecordset("SELECT * FROM kimlikbilgileri WHERE (((sira)=" & Me.mtn_sira & "))")
Do While Not Kayit.EOF
GeciciBelgeAdi = CurrentProject.Path & "\" & Format(Kayit.Fields("ADI").Value) & ".docx"
Set ResimBilgisi = Kayit.Fields("FOTOgRAF_1").Value
While Not ResimBilgisi.EOF
ResimAdi = GDosyaYolu & "a1a" & ResimBilgisi.Fields("FileName")
ResimBilgisi.Fields("FileData").SaveToFile ResimAdi
ResimBilgisi.MoveNext
Wend
Set ResimBilgisi2 = Kayit.Fields("FOTOgRAF_2").Value
While Not ResimBilgisi2.EOF
ResimAdi2 = GDosyaYolu & "b1b" & ResimBilgisi2.Fields("FileName")
ResimBilgisi2.Fields("FileData").SaveToFile ResimAdi2
ResimBilgisi2.MoveNext
Wend
Set ResimBilgisi3 = Kayit.Fields("FOTOgRAF_3").Value
While Not ResimBilgisi3.EOF
ResimAdi3 = GDosyaYolu & "c1c" & ResimBilgisi3.Fields("FileName")
ResimBilgisi3.Fields("FileData").SaveToFile ResimAdi3
ResimBilgisi3.MoveNext
Wend
Set ResimBilgisi4 = Kayit.Fields("FOTOgRAF_4").Value
While Not ResimBilgisi4.EOF
ResimAdi4 = GDosyaYolu & "d1d" & ResimBilgisi4.Fields("FileName")
ResimBilgisi4.Fields("FileData").SaveToFile ResimAdi4
ResimBilgisi4.MoveNext
Wend
' Set WordApp = GetObject(, "Word.Application")
' If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
BelgeAcik = True
' End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=GSablon, NewTemplate:=False
With WordApp
.Selection.GoTo what:=wdGoToBookmark, Name:="ad"
.Selection.TypeText Nz(Kayit.Fields("ADI"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="soyad"
.Selection.TypeText Nz(Kayit.Fields("SOYADI"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="tc"
.Selection.TypeText Nz(Kayit.Fields("tc"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="dogumyer"
.Selection.TypeText Nz(Kayit.Fields("DOGUM_YER"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="dogumtrh"
.Selection.TypeText Nz(Kayit.Fields("DOGUM_TARIH"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="olaytrh"
.Selection.TypeText Nz(Kayit.Fields("OLAYTARIH"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="gorevyer"
.Selection.TypeText Nz(Kayit.Fields("GOREVYER"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="gorev"
.Selection.TypeText Nz(Kayit.Fields("GOREVI"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="annead"
.Selection.TypeText Nz(Kayit.Fields("ANNEADI"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="babaad"
.Selection.TypeText Nz(Kayit.Fields("BABAADI"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="nufus"
.Selection.TypeText Nz(Kayit.Fields("KUTUK"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="adres"
.Selection.TypeText Nz(Kayit.Fields("AILEADRES"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="aranma"
.Selection.TypeText Nz(Kayit.Fields("ARANMA"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="durum"
.Selection.TypeText Nz(Kayit.Fields("DURUMU"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="adli"
.Selection.TypeText Nz(Kayit.Fields("ADLIKAYIT"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="ifade"
.Selection.TypeText Nz(Kayit.Fields("IFADE"), "")
.Selection.GoTo what:=wdGoToBookmark, Name:="gelen"
.Selection.TypeText Nz(Kayit.Fields("GELENBILGI"), "")
'/////resimler
If Len(ResimAdi) > 0 Then
.Selection.GoTo what:=wdGoToBookmark, Name:="res1"
Set AcikBelgeResim = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi, LinkToFile:=True, SaveWithDocument:=True)
With AcikBelgeResim
.LockAspectRatio = msoTrue
.Height = 110
.Width = 90
End With
End If
If Len(ResimAdi2) > 0 Then
.Selection.GoTo what:=wdGoToBookmark, Name:="res2"
Set AcikBelgeResim2 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi2, LinkToFile:=True, SaveWithDocument:=True)
With AcikBelgeResim2
.LockAspectRatio = msoTrue
.Height = 110
.Width = 90
End With
End If
If Len(ResimAdi3) > 0 Then
.Selection.GoTo what:=wdGoToBookmark, Name:="res3"
Set AcikBelgeResim3 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi3, LinkToFile:=True, SaveWithDocument:=True)
With AcikBelgeResim3
.LockAspectRatio = msoTrue
.Height = 110
.Width = 90
End With
End If
If Len(ResimAdi4) > 0 Then
.Selection.GoTo what:=wdGoToBookmark, Name:="res4"
Set AcikBelgeResim4 = .Selection.InlineShapes.AddPicture(FileName:=ResimAdi4, LinkToFile:=True, SaveWithDocument:=True)
With AcikBelgeResim4
.LockAspectRatio = msoTrue
.Height = 110
.Width = 90
End With
End If
WordApp.ActiveDocument.SaveAs2 (GeciciBelgeAdi)
WordApp.Documents.Close False
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
End With
Kayit.MoveNext
Loop
If FileExists(GeciciBelgeAdi) = True Then
If MsgBox("Oluşturulan " & GeciciBelgeAdi & " isimli dosya açılsın mı?", vbYesNo, "Belge Aç") = vbYes Then
Set WordApp = New Word.Application
With WordApp
.Visible = True
.WindowState = wdWindowStateMaximize
.Documents.Open (GeciciBelgeAdi)
End With
End If
End If
Konuyu Okuyanlar: 1 Ziyaretçi
