Skip to main content

AccessTr.neT


Word Boyama İşlemi

Word Boyama İşlemi

#19
(22/11/2017, 11:32)ozanakkaya yazdı: Merhaba, ekteki uygulamayı deneyip bilgi veriniz.

Hocam şuan çalışıyor. Problem nerden kaynaklıymış?
Cevapla
#20
Merhaba, docx uzantılı dosya yerine dotx uzantılı şablon dosyası kullanıldı.
Konu taşınmıştır.
Cevapla
#21
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.
Cevapla
#22
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ü.
Cevapla
#23
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.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task