bu kodla direkt sorguyu worde vermeye çalışıyorum raporu değil... ve bir çok sorguyuda yine bu şekilde worde vericeğim için sorunu sorguda çözmek eğer mümkünse çok iyi olur...

Dim WordApp As Word.Application

 

   Dim strTemplateLocation As String

 

    strTemplateLocation = CurrentProject.Path & "\PRO.dot"

 

   On Error Resume Next

 

  Set WordApp = CreateObject("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



   With WordApp.Selection

 DoCmd.OpenQuery "BİLGİLER1SORGU" ' Burayı Değiştirdik

 DoCmd.RunCommand acCmdSelectAllRecords

 DoCmd.RunCommand acCmdCopy



  WordApp.ActiveDocument.Bookmarks("BİLGİLER1").Range.Paste

  

  End With

   

   With WordApp.Selection

 DoCmd.OpenQuery "BİLGİLER2SORGU" ' Burayı Değiştirdik

 DoCmd.RunCommand acCmdSelectAllRecords

 DoCmd.RunCommand acCmdCopy



  

 WordApp.ActiveDocument.Bookmarks("BİLGİLER2").Range.Paste

End With



   With WordApp.Selection

 DoCmd.OpenQuery "BİLGİLER3SORGU" ' Burayı Değiştirdik

 DoCmd.RunCommand acCmdSelectAllRecords

 DoCmd.RunCommand acCmdCopy



  

 WordApp.ActiveDocument.Bookmarks("BİLGİLER3").Range.Paste

  WordApp.ActiveDocument.Bookmarks("BİLGİLER3").Range.Paste

End With



   With WordApp.Selection

 DoCmd.OpenQuery "BİLGİLER4SORGU" ' Burayı Değiştirdik

 DoCmd.RunCommand acCmdSelectAllRecords

 DoCmd.RunCommand acCmdCopy



  

 WordApp.ActiveDocument.Bookmarks("BİLGİLER4").Range.Paste

End With



 

WordApp.ActiveDocument.Range.Tables(1).Rows(1).Delete '**** Burayı ekledik. ****

WordApp.ActiveDocument.Range.Tables(1).AutoFitBehavior (wdAutoFitWindow)

WordApp.ActiveDocument.Range.Tables(2).Rows(1).Delete '**** Burayı ekledik. ****

WordApp.ActiveDocument.Range.Tables(2).AutoFitBehavior (wdAutoFitWindow)

WordApp.ActiveDocument.Range.Tables(3).Rows(1).Delete '**** Burayı ekledik. ****

WordApp.ActiveDocument.Range.Tables(3).AutoFitBehavior (wdAutoFitWindow)

WordApp.ActiveDocument.Range.Tables(4).Rows(1).Delete '**** Burayı ekledik. ****

WordApp.ActiveDocument.Range.Tables(4).AutoFitBehavior (wdAutoFitWindow)









   DoEvents

   WordApp.Activate



   Set WordApp = Nothing

   Exit Sub

 

ErrHandler:

Set WordApp = Nothing