Skip to main content

AccessTr.neT


Word Şablonu Hazırlama Yardım

Word Şablonu Hazırlama Yardım

Çözüldü #1
Merhaba Değerli hocalarım.

Access raporu için word şablon hazırlamayı düşünüyorum. Bu konu ile alakalı olarak örnek dosyaları ve konuları inceledim fakat doğrusu çokta bir şey anlayamadım.

bu şablon hazırlama konusunda detaylı bilgi verebilirmisiniz. 
saygılarımla
Cevapla
#2
Merhaba, 

Cvp: Word Boyama İşlemi - 8 bağlantısında bulunan mesajdaki  Ödeme Takip.rar isimli örneği inceleyiniz.

Örneği rardan çıkardığınızda "Ödeme Takibi Uygulaması\Master Dosyalar" dizinindeki TL HESABI.docx isimli word belgesini açıp "Ekle" Sekmesinde "Yer İşareti"ni tıkladığınızda "txtalici" isimli yer işaretini görebilirsiniz.

Ödeme Takip.accdb isimli uygulamanın raporunda

Dim appword As Word.Application
Dim doc As Word.Document
Dim Path As String

On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Path = CurrentProject.Path & "\Ödeme Takibi Uygulaması\Master Dosyalar\TL HESABI.docx"
Set doc = appword.Documents.Open(Path, , True)
With doc
.Bookmarks("txtalici").Range.Text = Me.Alıcı

appword.Visible = True
appword.Activate
End With

Set doc = Nothing
Set appword = Nothing

şeklinde kod mevcut. Bu kod ile TL Hesabı isimli word belgesini açtırıp txtalici yerimine "Alıcı" alanındaki veriyi aktarır.
Cevapla
#3
Sayın Ozan hocam merhaba.
İlginize çok teşekkür ederim. Ofis sürümü nedeni ile linkte belirttiğiniz örneği inceleyemedim.

Ofis Sürüm: 2007

Yapmak istediğim ekli dosyada "frm_risk" formu ve alt formlarda girilen  bilgileri "S_risk" sorgusu ile acces rapor yerine ekli dosyada bulunan rapor.dotx içindeki şablona (resimler ile) kaydederek rapor almak istiyorum.
sorguda bulunan her alanı bu şablonda bulunan tablo içine satır satır aktarmak istiyorum.

Örnek uygulamaları inceleyip şu kod yordamı ile anaform üzerindeki bir alanı sorguda açtırıp Word dosyasına yazdıra biliyorum
Kod:
Kod:
   If MsgBox("D İ K K A T" & Chr(13) & _
    "Bilgiler Şablona Yazdırılacak. Onaylıyor musunuz?", vbInformation + vbOKCancel) = vbOK Then
 Else
      Exit Sub
   End If
   Dim rs As New ADODB.Recordset
   Dim objWord  As Word.Application  'word programı
   Dim objDocument As Object 'word belgesi
   Dim objselection As Object
   Dim objtable As Word.Table
   Dim objrange As Word.Range
DoCmd.OpenQuery "S_RISK"

Set objWord = New Word.Application
        objWord.Visible = True 'word programını görünür hale getiriyoruz.
       Set objDocument = objWord.Documents.Add
       Set objselection = objWord.Selection()
       objWord.Selection.Font.Size = 12 'Yazı Büyüklüğü
       objWord.Selection.Paragraphs.SpaceAfter = 0
       objWord.Selection.Paragraphs.SpaceBefore = 0
       objWord.Selection.Font.Name = (Arial) ' Yazı Karakteri
       With objWord.Selection

       
       .TypeText (Me.Detay)
       .Font.Bold = True

 
   
  Set WordApp = Nothing
End With


yukarıdaki kod yordamında nasıl bir yol izlersem alt formdaki bir alanı sorguda açıp worde yazdırabilirim?
ilginize teşekkür ederim.
Son Düzenleme: 23/05/2018, 14:04, Düzenleyen: murat dikme.
Cevapla
#4
Icon_rolleyes
Cevapla
#5
Merhaba,

- 1 Mb'lık örneği 10 Mb. olarak eklemişsiniz.
 
- Bu kod ile ve bu şablon ile hiçbir aktarma yapamazsınız. Örnek uygulamanızda da mesajınızda belirttiğiniz koda rastlamadım. Şablonunuzda da yer imi yok.

- Forma denetim kaynağı "DEVKRTNOT" olan metin kutusu eklediğinizde bu metin kutusunun adı "mtn_DEVKRTNOT" olarak değiştirilir, Metin384 olarak bırakılmaz. Kod yazarken neyin ne olduğu belli olur.

- Alt formda metin kutusunda bulunan veriyi  Forms![frm_risk]![frm_riska].Form![Metin384]  şeklindeki kod ile alabilirsiniz.

Resimli worde aktarma için Cvp: Worde Butonla Resim Akatramak - 3 bağlantısındaki örneği kullanabilirsiniz.
Cevapla
#6
Sayın Ozan Hocam merhaba.
- Konuda belirttiğim kodu konuyu açtıktan sonra örnek dosyaları incelerken gördüm eklediğim uygulamada yok. Kendi uygulamam içinde denedim ana form üzerindeki alanı yer imi olmadan word dosyasına aktarmakta. Fakat alt formdaki alanı aktaramadım.
- Kodu çalıştırdığımda sorguyu açmakta ve sonrasında yeni bir word dosyası açarak alanı sorgudan değil formdan alarak aktarmakta.
- Yabancı bir siteden bulduğum kod ise sorgu üzerinden dosya konumu belirtilen word dosyasına tablo oluşturarak sorgudaki bilgileri bu tabloya aktarmakta. (benim yapmak istediğim tam da bu) Fakat kendi uylamama eklediğimde runtime eror 3061 hatasını vermekte

KOD:
Kod:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer
Dim intRecords As Integer
Dim intColumns As Integer

strSQL = "qryTest"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
       
   If rs.EOF = True Then
   
           MsgBox "No records were retrieved. Cannot continue.", vbCritical, "Request Aborted"
           rs.Close
       Set db = Nothing
       Exit Sub
       
   End If
   
   
'lets get some counts
rs.MoveLast
intRecords = 0
intRecords = rs.RecordCount
Debug.Print "rs.RecordCount = " & intRecords

'Name the Range for the data added
intRecords = intRecords + 1  'add one row for the header names

'lets see how many columns we have
intColumns = 0
intColumns = rs.Fields.Count
   
'*************************************



Dim myWordApp As Word.Application
Dim docNew As Word.Document
Dim docTable As Word.Table

Set myWordApp = CreateObject("Word.Application")

myWordApp.Visible = True
Set docNew = myWordApp.Documents.Open("C:\Test\WordDocFolder\TestMailMerge.docx")


'Create a table that has the correct number of cells
docNew.Tables.Add Range:=docNew.Range(Start:=0, End:=0), NumRows:=intRecords, NumColumns:=intColumns

Set docTable = docNew.Tables(1)

'Get some header names in the first Row
   For i = 1 To rs.Fields.Count
       docTable.Cell(1, i).Range.Text = rs.Fields(i - 1).Name
   Next i

rs.MoveLast

While rs.BOF = False

'Populate the last row
   For i = 1 To rs.Fields.Count
       If Not IsNull(rs.Fields(i - 1).Value) Then
       docTable.Cell(intRecords, i).Range.Text = rs.Fields(i - 1).Value
       End If
   Next i
Debug.Print intRecords
intRecords = intRecords - 1
rs.MovePrevious

Wend


docNew.Save
docNew.Close
myWordApp.Quit

Set docNew = Nothing
Set myWordApp = Nothing

Son Düzenleme: 23/05/2018, 10:59, Düzenleyen: murat dikme.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task