(22/11/2017, 11:32)ozanakkaya yazdı: Merhaba, ekteki uygulamayı deneyip bilgi veriniz.
Hocam şuan çalışıyor. Problem nerden kaynaklıymış?
Hocam şuan çalışıyor. Problem nerden kaynaklıymış?
Word Boyama İşlemi
Hocam şuan çalışıyor. Problem nerden kaynaklıymış?
Merhaba, docx uzantılı dosya yerine dotx uzantılı şablon dosyası kullanıldı.
Konu taşınmıştır.
Konu taşınmıştır.
Word kaydetme işlemini bir türlü sağlatamıyorum. Aynı mantıkta çalışan Excel modülü var kaydediyor. Kodları inceleyip yardımcı olabilirmisiniz.
Kod:
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
With WordApp.Selection
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordset.Open ("Select ea_no, be_no, uygulama, alan_adres, alan_adi, veri_adres" & _
" From tbl_evrakhazirlaalanlistesi" & _
" Where be_no =" & e_no)
'find the target record
While objRecordset.EOF = False
'check for match
dataadres = objRecordset.Fields(3).value
veri = objRecordset.Fields(5).value
'veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
If IsNull(Me(veri).value) Then
veriform = " "
Else
veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
End If
If IsNull(veriform) Then
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText " "
MsgBox dataadres, vbCritical
Else
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText veriform
End If
objRecordset.MoveNext
Wend
Dim Path4 As String
Path4 = CurrentProject.Path & "/Ödeme Takibi Uygulaması/Arşiv/" & [İş] & "/" & [Kimlik] & " - " & [Firma] & "/"
Dim FileN As String
Dim both As String
FileN = h_evrak & "-" & [Fatura No] & ".doc"
both = Path4 & FileN
WordApp.ActiveDocument.SaveAs FileName:=both, FileFormat:=wdFormatText
Set WordApp = Nothing
DoEvents
End With
Exit Sub
ErrHandler:
Set WordApp = Nothing
MsgBox "error"
End If
End Sub
Son Düzenleme: 05/07/2018, 12:46, Düzenleyen: mertkose.
Kod içerisinde strTemplateLocation ibaresi var ancak bununla ilgili herhangi bir tanım yok.
Örnek uygulamanızı ekleyerek Access soruları bölümüne yeni konu açınız. Bu bölüm Cevaplanmış Soru bölümü.
Örnek uygulamanızı ekleyerek Access soruları bölümüne yeni konu açınız. Bu bölüm Cevaplanmış Soru bölümü.
ozanakkaya yazdı:Kod içerisinde strTemplateLocation ibaresi var ancak bununla ilgili herhangi bir tanım yok.
Örnek uygulamanızı ekleyerek Access soruları bölümüne yeni konu açınız. Bu bölüm Cevaplanmış Soru bölümü.
strTemplateLocation yukarıda tanımlı hocam uygulama aynı uygulama olduğu için bu konuyu devam ettirdim.
Kod:
Sub WordHazirla(h_evrak)
Dim masterdosya As String
Dim e_no As String
Dim haz_evrak As String
haz_evrak = h_evrak
Dim dataadres As Variant
Dim veri As String
Dim veriform As String
Dim dosyasorgusu As Variant, kriter As String
kriter = "para_birimi='" & [Para Birimi] & "' And evrakadi='" & haz_evrak & "'"
dosyasorgusu = DLookup("masteradresi", "tbl_evraklistesi", kriter)
If IsNull(dosyasorgusu) Then
MsgBox "Master dosya tanımlanamadı.", vbApplicationModal, "Piu Muhasebe Form Yönetim Sistemi Uyarı"
Exit Sub
Else
masterdosya = dosyasorgusu
e_no = DLookup("e_no", "tbl_evraklistesi", kriter)
MsgBox masterdosya, vbCritical, Uyarı
End If
If masterdosya = "" Then
MsgBox "Evrak hazırlanamıyor."
Else
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim newPicture
Dim Path As String
Path = CurrentProject.Path & "/Ödeme Takibi Uygulaması/Arşiv/" & [İş] & "/" & [Kimlik] & " - " & [Firma] & "/"
strTemplateLocation = masterdosya
On Error Resume Next
Set WordApp = GetObject(Path, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
With WordApp.Selection
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordset.Open ("Select ea_no, be_no, uygulama, alan_adres, alan_adi, veri_adres" & _
" From tbl_evrakhazirlaalanlistesi" & _
" Where be_no =" & e_no)
'find the target record
While objRecordset.EOF = False
'check for match
dataadres = objRecordset.Fields(3).value
veri = objRecordset.Fields(5).value
'veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
If IsNull(Me(veri).value) Then
veriform = " "
Else
veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
End If
If IsNull(veriform) Then
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText " "
MsgBox dataadres, vbCritical
Else
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText veriform
End If
objRecordset.MoveNext
Wend
Dim Path4 As String
[size=2][font=Monaco, Consolas, Courier, monospace] Path4 = CurrentProject.Path & "/Ödeme Ta[/font][/size][size=2][font=Monaco, Consolas, Courier, monospace]kibi Uygulaması/Arşiv/" & [İş] & "/" & [Kimlik] & " - " & [Firma] & "/"[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] [/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] Dim FileN As String[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] Dim both As String[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] FileN = h_evrak & "-" & [Fatura No] & ".doc"[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] both = Path4 & FileN[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] [/font][/size]
WordApp.ActiveDocument.SaveAs (both)
Set WordApp = Nothing
DoEvents
End With
Exit Sub
ErrHandler:
Set WordApp = Nothing
MsgBox "error"
End If
End Sub
Son Düzenleme: 05/07/2018, 12:50, Düzenleyen: mertkose.
Konuyu Okuyanlar:
