Formdan Word Dosyasına Aktarma Sorunu

1 2
07/04/2020, 09:10

ozanakkaya

Uygulamanızın son halini ekleyin.
07/04/2020, 14:27

suayip

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.
07/04/2020, 15:20

ozanakkaya

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
09/04/2020, 01:25

suayip

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