Formdan Word Dosyasına Aktarma Sorunu

Uygulamanızın son halini ekleyin.

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.

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

Çok teşekkür ederim Ozan Hocam.Kodlar çalışıyor.Emeğine sağlık.