Daha önceki konunuza eklediğim kodu kullanıyorsanız,


   Dim WordApp As Object
   Dim strTemplateLocation As String
   Dim GMesaj As Long
   Dim YerimiKontrol As Integer
   
   YerimiKontrol = 1
   GGecerliBelgeYolu = CurrentProject.path & "\" & SM_Kimlik & "_Evrak.doc"
   
       If FileExists(GGecerliBelgeYolu) = True Then
       
        GMesaj = MsgBox(Me.SM_Kimlik & "Sayılı Uzlaştırma Raporu daha önce oluşturulmuş. Yeni Belge Oluşturulsun mu?" & Chr(13) & Chr(10) & "Evet= Yeni Belge Oluştur." & Chr(13) & Chr(10) & "Hayır= Eski Belgeyi Aç." & Chr(13) & Chr(10) & "İptal= İşlemden Vazgeç. ", vbYesNoCancel + vbQuestion, "BİLGİ")

            Select Case GMesaj
                Case vbYes
                GoTo 200
                Case vbNo
                Set WordApp = CreateObject(Class:="Word.Application")
                WordApp.Visible = True
                AppActivate "Microsoft Word"
               
                WordApp.Documents.Open FileName:=GGecerliBelgeYolu
            
                Exit Sub
                Case vbCancel
                Exit Sub
            End Select
        End If
   
   
200


   strTemplateLocation = CurrentProject.path & "\uzlastirma_raporu.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 = 1
   
   
   Set oWdoc = WordApp.Documents.Add(Template:=strTemplateLocation, NewTemplate:=False)
   
  
    
   DoEvents
   WordApp.Activate
   
    Set qdf = CurrentDb.QueryDefs("srg_kayitkisiler")
    qdf![Forms!Kayıt_Giriş!SM_Kimlik] = [Forms]![Kayıt_Giriş]![SM_Kimlik]
     
    Set rs = qdf.OpenRecordset()
    
    Dim strCriteria As String
    
    Set db = CurrentDb
    
    
    WordApp.ActiveDocument.Bookmarks("uzlasno").Select
    WordApp.Selection.Text = Space(2) & Me.Uzlaştırma_No_Giriş
    WordApp.ActiveDocument.Bookmarks("sorusturno").Select
    WordApp.Selection.Text = Space(2) & Me.C_B_Sorusturma_No_Giriş

    

    
        With rs
                .MoveFirst
    '        If .RecordCount <> 0 Then
                .MoveLast
                .MoveFirst
                iRecCount = .RecordCount + 1

                iFldCount = 2
                TabloSutun = 2
                TabloSatir = 4
                
                For I = 1 To .RecordCount
                
                
                If rs!Teklif_Uzlasma_Yapılan = "Müdafi" Or rs!Teklif_Uzlasma_Yapılan = "Vekil" Then
                
                    TabloSatir = 5
                
                End If
                
                
                WordApp.ActiveDocument.Bookmarks("katilanlar" & I).Select
                
                         
                WordApp.ActiveDocument.Tables.Add Range:=WordApp.Selection.Range, NumRows:=TabloSatir, NumColumns:= _
                                                TabloSutun, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                                                wdAutoFitFixed

                WordApp.ActiveDocument.Tables(I).Borders.Enable = False
     
                Set oWordTbl = oWdoc.Tables(I)
               
                    oWordTbl.Columns(1).Width = (220)
    
                    oWdoc.Tables(I).Cell(1, 1) = Nz(rs!Teklif_Uzlasma_Yapılan, "")
                    oWdoc.Tables(I).Cell(1, 1).Range.Font.Bold = True
                    oWdoc.Tables(I).Cell(1, 1).Range.Font.Underline = True
                    oWdoc.Tables(I).Cell(2, 1) = Space(7) & "Adı ve Soyadı"
                    oWdoc.Tables(I).Cell(2, 2) = ":" & Nz(rs!Sphl_Adı_Soyadı, "")
                    
                    oWdoc.Tables(I).Cell(3, 1) = Space(7) & "T.C. kimlik numarası"
                    oWdoc.Tables(I).Cell(3, 2) = ":" & Nz(rs!Sphl_TC_kimlik_numarası, "")
                    
                    oWordTbl.Cell(4, 1) = Space(7) & "Adresi"
                    oWordTbl.Cell(4, 2) = ":" & Nz(rs!Sphl_Adresi, "")
                    
                    If rs!Teklif_Uzlasma_Yapılan = "Müdafi" Or rs!Teklif_Uzlasma_Yapılan = "Vekil" Then
                        oWordTbl.Cell(5, 1) = Space(7) & "Kayıtlı olduğu baro ve sicil numarası"
                        oWordTbl.Cell(5, 2) = ":" & Nz(rs!Sphl_Baro_Sicil, "")
                    End If
                
                    .MoveNext
                    YerimiKontrol = YerimiKontrol + 1
                Next I
                           
                For A = YerimiKontrol To 7
                
                 oWdoc.Bookmarks("katilanlar" & A).Delete
                
                Next
                

 
               
          End With
   
'   If FolderExists(CurrentProject.path & "\" & Left(Me.is_adi, 25)) = False Then
'        MkDir CurrentProject.path & "\" & Left(Me.is_adi, 25)
'    End If
   
   oWdoc.SaveAs2 GGecerliBelgeYolu


   Set WordApp = Nothing

ErrHandler:
Set WordApp = Nothing
Debug.Print Error

_______________________________________

Koda yeni eklediğim kısımları kırmızı renkli yaptım.