Skip to main content

AccessTr.neT


Word Şablonu Hazırlama Yardım

Word Şablonu Hazırlama Yardım

#17
(03/06/2018, 16:22)murat dikme yazdı: Fakat butona tıklandığında ilgili referans yüklü olmasına rağmen. "activex component can't create object hatası almaktayım. sıkıştır onar yapıp çalışmayı kapatıp açınca sorun düzeliyor.

Hatanın sebebi, formu açıp hiç tasarım görünümüne geçmeden butonu tıkladığınızda worde aktarımı yapar, ancak buton tıkladıktan sonra word belgesi açık iken formu tasarımda açarsanız bu hatayı verebilir.

(03/06/2018, 16:22)murat dikme yazdı: Çalışmada word rapor u alırken şablonda sadece tek sayfa aktarmaktadır. Benim yapmak istediğim çalışma içinde bulunan "riskrapor" da olduğu gibi her soruyu faklı sayfalara eklemek.
Word şablonu ile bu işlemi yapamazsınız. Yeni word belgesi oluşturup verileri oluşturulan bu belgeye aktarmanız lazım.

Aşağıdaki kod word belgesine üst tabloyu ekler ve resim ile birlikte test amaçlı 1 veri gönderir.

Dim oWordDoc As Word.Document
Dim WordApp As Word.Application
Dim sDocument As String


   sDocument = CurrentProject.Path & "\Risk Raporu.doc"
   
   Set WordApp = CreateObject("Word.Application")
   
   WordApp.Visible = True
   
   AppActivate "Microsoft Word"
   
   If FileExists(sDocument) = False Then
   
       Set oWordDoc = WordApp.Documents.Add
       oWordDoc.SaveAs sDocument
  Else
                   
       Set oWordDoc = WordApp.Documents.Open(CurrentProject.Path & "\Risk Raporu.doc")
   
   End If


   
       WordApp.ActiveDocument.Sections(1).PageSetup.Orientation = wdOrientLandscape
       WordApp.ActiveDocument.Sections(1).PageSetup.LeftMargin = InchesToPoints(0.75)
       WordApp.ActiveDocument.Sections(1).PageSetup.RightMargin = InchesToPoints(0.1)
       WordApp.ActiveDocument.Sections(1).PageSetup.TopMargin = InchesToPoints(0.3)
       WordApp.ActiveDocument.Sections(1).PageSetup.BottomMargin = InchesToPoints(0.2)

   i = 1

   Set db = CurrentDb
   Set rs = db.OpenRecordset("sorgu_rapor", dbOpenSnapshot)
   
   rs.MoveLast:    rs.MoveFirst
   GVeriSayisi = rs.RecordCount

       If GVeriSayisi <> 0 Then
     
           Do Until rs.EOF = True
                 
           WordApp.Selection.Font.Bold = True
           WordApp.Selection.Font.Size = "24"
           WordApp.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
           
           WordApp.Selection.TypeText "TESPİT EDİLEN RİSK VE AÇIKLAMASI"
         
           WordApp.ActiveDocument.Tables.Add Range:=WordApp.Selection.Range, NumRows:=6, NumColumns:= _
                                           3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
                                           wdAutoFitFixed
                   
           Set oWordTbl = oWordDoc.Tables(i)
           
           oWordTbl.Cell(1, 1).Select
           WordApp.Selection.Font.Size = "9"
           oWordTbl.Rows(1).Height = "0.5"
           WordApp.Selection.TypeText "TESPİT EDİLEN RİK KONUSU"
           
           oWordTbl.Cell(3, 1).Select
           WordApp.Selection.Font.Size = "9"
           oWordTbl.Rows(3).Height = "0.5"
           WordApp.Selection.TypeText "TESPİT EDİLEN RİSK DURUMU"
           
           oWordTbl.Cell(5, 1).Select
           WordApp.Selection.Font.Size = "9"
           oWordTbl.Rows(5).Height = "0.5"
           WordApp.Selection.TypeText "TESPŞT EDİLEN RİSK İLE İLGİLİ AÇIKLAMA"
           
           oWordTbl.Rows(6).HeightRule = wdRowHeightExactly

           oWordTbl.Rows(6).Height = 99
           
           

           oWordTbl.Cell(Row:=1, Column:=2).Merge _
           MergeTo:=oWordTbl.Cell(Row:=6, Column:=2)
           oWordTbl.Cell(Row:=1, Column:=3).Merge _
           MergeTo:=oWordTbl.Cell(Row:=6, Column:=3)
           

       GResimYolu = rs!txtresim1.Value
           
       If Len(GResimYolu) > 0 Then
           oWordTbl.Cell(6, 1).Select
       Set newPicture = WordApp.Selection.InlineShapes.AddPicture(FileName:=rs!txtresim1.Value, LinkToFile:=False, SaveWithDocument:=True)
           newPicture.LockAspectRatio = msoTrue
           newPicture.Height = 110
           newPicture.Width = 90
       
     End If
     
       oWordTbl.Cell(1, 2).Select
       WordApp.Selection.TypeText rs!SORU.Value
       
       oWordTbl.Select
       WordApp.Selection.Collapse WdCollapseDirection.wdCollapseEnd
       
       If GVeriSayisi <> i Then
           
           WordApp.Selection.InsertBreak Type:=wdPageBreak
       
       End If
       
       i = i + 1
       
       rs.MoveNext
 
       Loop

 End If
Bu kod üstte belirttiğim gibi test amaçlıdır.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Word Şablonu Hazırlama Yardım - Yazar: murat dikme - 20/05/2018, 23:23
Cvp: Word Şablonu Hazırlama Yardım - Yazar: ozanakkaya - 04/06/2018, 15:02
Cvp: Word Şablonu Hazırlama Yardım - Yazar: bibib - 09/06/2018, 01:24
Task