Skip to main content

AccessTr.neT


Worde Aktarmada Resim Olmadığında Hata

Worde Aktarmada Resim Olmadığında Hata

Çözüldü #1
Merhaba Değerli Hocalarım.
Ekli çalışmamda son aşamaya gelmiş bulunmaktayım. frm_degerlendir formunda word rapor istediğimde  aktarım yaptığında resim var  ise sorun yok aktarım yapmakta. resim yok ise worde aktarım yapmayı durdurmakta ve hata vermektedir. Hata alınan satır ise şöyle
Kod:
Set newPicture = oWord.Selection.InlineShapes.AddPicture(FileName:=rs!txtresim1.Value, LinkToFile:=True, SaveWithDocument:=True)

Bu sorunu nasıl düzeltebilirim.
Destekleriniz ve yardımlarınız için şimdiden çok teşekkür ederim.
.rar RİSK.rar (Dosya Boyutu: 239,52 KB | İndirme Sayısı: 6)
Son Düzenleme: 22/06/2018, 11:53, Düzenleyen: murat dikme.
Cevapla
#2
Kodu aşağıdaki ile değiştir.

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!mtn_pıd] = [Forms]![frm_degerlendir]![mtn_pıd]
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 = Nz(rs!txtresim1.Value, "")
GResimYolu2 = Nz(rs!txtresim2.Value, "")
GResimYolu3 = Nz(rs!txtresim3.Value, "")
GResimYolu4 = Nz(rs!txtresim4.Value, "")



If Len(GResimYolu) > 0 And FileExists(GResimYolu) = True 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 And FileExists(GResimYolu2) = True 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 Nz(rs!SORU.Value, "")
oWordTbl.Cell(4, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText Nz(rs!TESDUR.Value, "")
oWordTbl.Cell(6, 1).Select
oWord.Selection.Font.Size = "12"
oWord.Selection.TypeText Nz(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 And FileExists(GResimYolu3) = True 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 And FileExists(GResimYolu4) = True 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 Nz(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

Ayrıca, kodda tasarım değişikliği yapmadım ancak bu şekilde kod yazılmaz kod nerede başlıyor, nerede bitiyor belli değil, kodları belirli düzen içerisinde yazmalısın.
Cevapla
#3
Sayın Hocam emeğinize ve yardımlarınız için çok teşekkür ederim. Konu cevabında yazdığınız kod sorunsuz çalışmaktadır. Çok teşekkürler.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da