04/06/2018, 18:42
Word Şablonu Hazırlama Yardım
04/06/2018, 19:11
murat dikme
Ozan hocam
Sorgunun Sql kaynağı aşağıdaki gibidir.
Sorgunun Sql kaynağı aşağıdaki gibidir.
SELECT sorgu_deegerlendir.PROJE.PROJE_ID, sorgu_deegerlendir.PROJE_ADI, sorgu_deegerlendir.PROJE_YETKILI, sorgu_deegerlendir.PROJE_MAIL, sorgu_deegerlendir.PROJE_TEL, sorgu_deegerlendir.PROJE_ADRESI, sorgu_deegerlendir.TARIH, sorgu_deegerlendir.PROGG, sorgu_deegerlendir.PRDAN, sorgu_deegerlendir.PRTEM, sorgu_deegerlendir.PRTEK, sorgu_deegerlendir.PRMUD, sorgu_deegerlendir.PRPEY, sorgu_deegerlendir.ACIKLA, sorgu_deegerlendir.SORU_ID, sorgu_deegerlendir.SORU, sorgu_deegerlendir.TESDUR, sorgu_deegerlendir.TESACIK, sorgu_deegerlendir.ONER, sorgu_deegerlendir.ONACIK, sorgu_deegerlendir.txtacikla, sorgu_deegerlendir.txtresim1, sorgu_deegerlendir.txtresim2, sorgu_deegerlendir.txtresim3, sorgu_deegerlendir.txtresim4, sorgu_deegerlendir.SORU.PROJE_ID
FROM sorgu_deegerlendir
WHERE (((sorgu_deegerlendir.PROJE.PROJE_ID)=[Forms]![frm_degerlendir]![PROJE_ID]));
04/06/2018, 19:25
ozanakkaya
Test için yeni buton oluştur. Tıklandığında olayına aşağıdaki kodları ekle
Dim oWordDoc As Word.Document
Dim oWord As Word.Application
Dim sDocument As String
Dim i, a, GVeriSayisi As Integer
Dim qdf As QueryDef
Dim rs As Recordset
sDocument = CurrentProject.Path & "\Risk Raporu.docx"
If FileExists(sDocument) Then
Kill sDocument
End If
Set oWord = CreateObject("Word.Application")
Set oWordDoc = oWord.Documents.Add
oWordDoc.SaveAs sDocument
oWord.Visible = True
oWord.WindowState = 1
DoEvents
oWord.Activate
oWordDoc.Sections.PageSetup.Orientation = wdOrientLandscape
oWordDoc.Sections.PageSetup.LeftMargin = InchesToPoints(0.75)
oWordDoc.Sections.PageSetup.RightMargin = InchesToPoints(0.1)
oWordDoc.Sections.PageSetup.TopMargin = InchesToPoints(0.3)
oWordDoc.Sections.PageSetup.BottomMargin = InchesToPoints(0.2)
i = 1
Set qdf = CurrentDb.QueryDefs("sorgu_rapor")
qdf![Forms!frm_degerlendir!PROJE_ID] = [Forms]![frm_degerlendir]![PROJE_ID]
Set rs = qdf.OpenRecordset()
rs.MoveLast: rs.MoveFirst
GVeriSayisi = rs.RecordCount
If GVeriSayisi <> 0 Then
Do Until rs.EOF = True
oWord.Selection.Font.Bold = True
oWord.Selection.Font.Size = "24"
oWord.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
oWord.Selection.TypeText "TESPİT EDİLEN RİSK VE AÇIKLAMASI"
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=6, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set oWordTbl = oWordDoc.Tables(i)
oWordTbl.Cell(1, 1).Select
oWord.Selection.Font.Size = "9"
oWordTbl.Rows(1).Height = "0.5"
oWord.Selection.TypeText "TESPİT EDİLEN RİK KONUSU"
oWord.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphLeft
oWordTbl.Cell(3, 1).Select
oWord.Selection.Font.Size = "9"
oWordTbl.Rows(3).Height = "0.5"
oWord.Selection.TypeText "TESPİT EDİLEN RİSK DURUMU"
oWord.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphLeft
oWordTbl.Cell(5, 1).Select
oWord.Selection.Font.Size = "9"
oWordTbl.Rows(5).Height = "0.5"
oWord.Selection.TypeText "TESPŞT EDİLEN RİSK İLE İLGİLİ AÇIKLAMA"
oWord.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphLeft
oWordTbl.Rows(6).HeightRule = wdRowHeightExactly
oWordTbl.Rows(6).Height = 99
oWordTbl.Columns(1).Width = "12.75"
oWordTbl.Columns(2).Width = "7.5"
oWordTbl.Columns(3).Width = "7.5"
GResimYolu = rs!txtresim1.Value
GResimYolu2 = rs!txtresim2.Value
GResimYolu3 = rs!txtresim3.Value
GResimYolu4 = rs!txtresim4.Value
If Len(GResimYolu) > 0 Then
oWordTbl.Cell(1, 2).Select
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set newPicture = oWord.Selection.InlineShapes.AddPicture(FileName:=GResimYolu, LinkToFile:=True, SaveWithDocument:=True)
newPicture.Height = 150
newPicture.Width = 100
End If
If Len(GResimYolu2) > 0 Then
oWordTbl.Cell(1, 3).Select
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set newPicture = oWord.Selection.InlineShapes.AddPicture(FileName:=rs!txtresim2.Value, LinkToFile:=True, SaveWithDocument:=True)
newPicture.Height = 150
newPicture.Width = 100
End If
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)
oWordTbl.Cell(2, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText rs!SORU.Value
oWordTbl.Cell(4, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText rs!TESDUR.Value
oWordTbl.Cell(6, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText rs!TESACIK.Value
oWordTbl.Select
oWord.Selection.Collapse WdCollapseDirection.wdCollapseEnd
oWord.Selection.Paragraphs.Alignment = WdParagraphAlignment.wdAlignParagraphCenter
oWord.Selection.TypeText "TESPİT EDİLEN RİSK KONUSU ÖNERİSİ"
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=1, NumColumns:= _
3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
a = i + 1
Set oWordTbl = oWordDoc.Tables(a)
If Len(GResimYolu3) > 0 Then
oWordTbl.Cell(1, 2).Select
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set newPicture = oWord.Selection.InlineShapes.AddPicture(FileName:=GResimYolu3, LinkToFile:=False, SaveWithDocument:=True)
newPicture.LockAspectRatio = msoTrue
newPicture.Height = 150
newPicture.Width = 100
End If
If Len(GResimYolu4) > 0 Then
oWordTbl.Cell(1, 3).Select
oWord.ActiveDocument.Tables.Add Range:=oWord.Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Set newPicture = oWord.Selection.InlineShapes.AddPicture(FileName:=GResimYolu4, LinkToFile:=False, SaveWithDocument:=True)
newPicture.LockAspectRatio = msoTrue
newPicture.Height = 150
newPicture.Width = 100
End If
oWordTbl.Cell(3, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText rs!ONACIK.Value
oWordTbl.Select
oWord.Selection.Collapse WdCollapseDirection.wdCollapseEnd
'If GVeriSayisi <> i Then
oWord.Selection.InsertBreak Type:=wdPageBreak
'End If
i = i + 2
' Exit Sub
rs.MoveNext
Loop
End If 05/06/2018, 09:19
ozanakkaya
Bu arada, eklediğiniz örnek uygulamadaki formda PROJE_ID adında metin kutusu yok.
05/06/2018, 19:54
murat dikme
Ozan hocam tekrar tekrar denedim ama şu satırda hata vermekte.
qdf![Forms!frm_degerlendirme!mtn_pıd] = [Forms]![frm_degerlendirme]![mtn_pıd] 05/06/2018, 20:46
ozanakkaya
Hata veren kodda ölçüt yazıyor. Bu ölçüt sorgudaki ölçüt ile aynı mı?