Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
22/06/2018 11:48
Konu Sahibi
murat dikme
Yorumlar
2
Okunma
276
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy
Kullanici Avatari

murat dikme

Altın Üye
mu.... di....
 40
 41
 164
 24/10/2016
12
 İstanbul
 Özel Güvenlik Amiri
 Ofis 2007
Çözüldü 
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.



Kullanici Avatari

ozanakkaya

Kurucu
Oz.... Ak....
 39
 479
 11.969
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
 Dün,23:36
Kodu aşağıdaki ile değiştir.

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
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.


"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

Kullanici Avatari

murat dikme

Altın Üye
mu.... di....
 40
 41
 164
 24/10/2016
12
 İstanbul
 Özel Güvenlik Amiri
 Ofis 2007
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.




Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Activex Denetimlerinde Hata estapan 1 61 03/03/2019, 16:59
Son Yorum: estapan
Çözüldü Program Açılışında Hata Veriyor Deniz DEMİRCİOĞLU 15 236 20/02/2019, 23:57
Son Yorum: haliliyas
Çözüldü Raporda Resim Kalitesi Bilal Demirci 4 85 11/02/2019, 17:24
Son Yorum: Bilal Demirci
Çözüldü Accesten Excele Aktarırken Hata mmert06 10 331 30/01/2019, 17:40
Son Yorum: mmert06
Çözüldü Dlookup İle Açılan Kutudan İsim Seçince Forma Resim Getirmek... remi 6 209 29/01/2019, 11:51
Son Yorum: remi

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.