Skip to main content

AccessTr.neT


Worde Aktarımda Ön İzmele Ve Wordü Otomatik Kaydetme

Worde Aktarımda Ön İzmele Ve Wordü Otomatik Kaydetme

#1
Merhaba. 

Ekteki uygulamada bilgileri worde atarak yeni belge olarak açıyor. 

Benim yapmak istediğim eğer mümkünse talimatı oluştura tıkladığımda word dosyasının önizlemesini yapması ve word dosyasını otomatik olarak " Alıcı Adı ve kayıt edildiği tarih " adıyla kaydetmesi. 

wordle ilgili kullandığım komut şu şekilde;

Kod:
' Word Şablonundan yeni belge oluşturma.
  Dim WordApp As Word.Application
  Dim strTemplateLocation As String
 
  ' Şablonun bulunduğu yer
 

   
   strTemplateLocation = CurrentProject.Path & "\efttalimat.docx"
  On Error Resume Next
  Set WordApp = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
    Set WordApp = CreateObject("Word.Application")
  End If
  On Error GoTo ErrHandler
 
 
  WordApp.Visible = True
  WordApp.WindowState = wdWindowStateMaximize
  WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False

.rar Yeni klasör.rar (Dosya Boyutu: 146,75 KB | İndirme Sayısı: 17)
derzulya, proud to be a member of AccessTr.neT since 09-03-2009.
Cevapla
#2
Merhaba,

Yeni modül oluştur ve aşağıdaki kodları modüle ekle. Modülü kaydet.


Private Declare Function apiShellExecute Lib "shell32.dll" _
   Alias "ShellExecuteA" _
   (ByVal hwnd As Long, _
   ByVal lpOperation As String, _
   ByVal lpFile As String, _
   ByVal lpParameters As String, _
   ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) _
   As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'****************************************************

Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
   'First try ShellExecute
   lRet = apiShellExecute(hWndAccessApp, vbNullString, _
           stFile, vbNullString, vbNullString, lShowHow)
           
   If lRet > ERROR_SUCCESS Then
       stRet = vbNullString
       lRet = -1
   Else
       Select Case lRet
           Case ERROR_NO_ASSOC:
               'Try the OpenWith dialog
               varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                       & stFile, WIN_NORMAL)
               lRet = (varTaskID <> 0)
           Case ERROR_OUT_OF_MEM:
               stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
           Case ERROR_FILE_NOT_FOUND:
               stRet = "Error: File not found.  Couldn't Execute!"
           Case ERROR_PATH_NOT_FOUND:
               stRet = "Error: Path not found. Couldn't Execute!"
           Case ERROR_BAD_FORMAT:
               stRet = "Error:  Bad File Format. Couldn't Execute!"
           Case Else:
       End Select
   End If
   fHandleFile = lRet & _
               IIf(stRet = "", vbNullString, ", " & stRet)
End Function
'************ Code End **********





Komut29'un tıklandığında olayındaki kodu aşağıdaki ile değiştir.

'Eksik alan ve kaydedilmemiş kayıt kontrolü.
  If IsNull(bankaak) Then
    MsgBox "Banka Adı Boş Olamaz!"
    Me.bankaak.SetFocus
    Exit Sub
  End If
  If IsNull(subeak) Then
    MsgBox "Şube Adı Boş Olamaz!"
    Me.subeak.SetFocus
    Exit Sub
  End If
  If IsNull(hesapno) Then
    MsgBox "Hesap numarası boş olamaz!"
    Me.hesapno.SetFocus
    Exit Sub
  End If
  If IsNull(hesapadi) Then
    MsgBox "Hesap Adı Boş olamaz!"
    Me.hesapadi.SetFocus
    Exit Sub
  End If
    If IsNull(SayiRakkamla) Then
    MsgBox "Tutar boş olamaz!"
    Me.SayiRakkamla.SetFocus
    Exit Sub
  End If
    If IsNull(yaziylatutar) Then
    MsgBox "Tutar Boş olamaz!"
    Me.yaziylatutar.SetFocus
    Exit Sub
  End If
         If IsNull(aliciadi) Then
    MsgBox "Alıcı Adı Boş olamaz!"
    Me.aliciadi.SetFocus
    Exit Sub
  End If
    If IsNull(alicibankaadi) Then
    MsgBox "Alıcı Banka Adı Boş olamaz!"
    Me.alicibankaadi.SetFocus
    Exit Sub
  End If
   If IsNull(alicisubeadi) Then
    MsgBox "Alıcı Şube Adı Boş olamaz!"
    Me.alicisubeadi.SetFocus
    Exit Sub
  End If
   
 
  If MsgBox("HATIRLATMA.. " & Chr(13) & _
    "Yazdırılacak!", vbInformation + vbOKCancel) = vbOK Then
 Else
      Exit Sub
    End If
  ' Word Şablonundan yeni belge oluşturma.
  Dim WordApp As Word.Application
  Dim strTemplateLocation As String
 
  ' Şablonun bulunduğu yer
 

   
   strTemplateLocation = CurrentProject.Path & "\efttalimat.docx"
  On Error Resume Next
  Set WordApp = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
    Set WordApp = CreateObject("Word.Application")
  End If
 
'  On Error GoTo ErrHandler
 
 
  WordApp.Visible = False
  WordApp.WindowState = wdWindowStateMaximize
  WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
   
  ' Her satırı uygun olan kayıt ile değiştirmek.
  With WordApp.Selection
 
    .GoTo what:=wdGoToBookmark, Name:="bankaak"
    .TypeText [bankaak].Column(1)
   
    .GoTo what:=wdGoToBookmark, Name:="subeak"
    .TypeText [subeak].Column(1)
   
    .GoTo what:=wdGoToBookmark, Name:="hesapno"
    .TypeText [hesapno].Column(2)

    .GoTo what:=wdGoToBookmark, Name:="hesapadi"
    .TypeText [hesapadi].Column(2)
   
    .GoTo what:=wdGoToBookmark, Name:="SayiRakkamla"
    .TypeText [SayiRakkamla]

    .GoTo what:=wdGoToBookmark, Name:="yaziylatutar"
    .TypeText [yaziylatutar]
   
    .GoTo what:=wdGoToBookmark, Name:="aliciadi"
    .TypeText [aliciadi]
   
    .GoTo what:=wdGoToBookmark, Name:="alicibankaadi"
    .TypeText [alicibankaadi]
   
    .GoTo what:=wdGoToBookmark, Name:="alicisubeadi"
    .TypeText [alicisubeadi]
   
    .GoTo what:=wdGoToBookmark, Name:="alicihesapno"
    .TypeText [alicihesapno]

    .GoTo what:=wdGoToBookmark, Name:="aliciibanno"
    .TypeText [aliciibanno]
   
     .GoTo what:=wdGoToBookmark, Name:="aciklama"
    .TypeText [aciklama]
   
     .GoTo what:=wdGoToBookmark, Name:="tcvergino"
    .TypeText [tcvergino]
   
    .GoTo what:=wdGoToBookmark, Name:="tarih"
    .TypeText [tarih]
   
   End With
   
 Dim BelgeAdi, BelgeYolu As String
 
 BelgeAdi = aliciadi & "-" & Date & ".docx"
 BelgeYolu = CurrentProject.Path & "\" & BelgeAdi

 WordApp.ActiveDocument.SaveAs BelgeYolu ', wdFormatDocument
 WordApp.Application.Quit
   
If MsgBox(BelgeAdi & " isimli belge oluşturuldu. Dosya Açılsın mı?", vbInformation + vbYesNo, "Belge Aç") = vbYes Then

   Call fHandleFile(BelgeYolu, WIN_NORMAL)
   
End If
   
     
'  DoEvents
'  WordApp.Activate
   
   
Set WordApp = Nothing
'   Exit Sub


'ErrHandler:

'Set WordApp = Nothing
Cevapla
#3
Teşekkür ederim.
derzulya, proud to be a member of AccessTr.neT since 09-03-2009.
Cevapla
#4
son olarak  yeni oluşturulan dosyaların programın olduğu konumdaki arşiv klasörüne kaydetmesi için kodu nasıl revize etmeliyim

Kod:
BelgeYolu = CurrentProject.Path & "\" & BelgeAdi
sanırım bu kodda bir değişiklik olacak
derzulya, proud to be a member of AccessTr.neT since 09-03-2009.
Son Düzenleme: 25/05/2017, 08:17, Düzenleyen: derzulya.
Cevapla
#5
Kod:
  BelgeYolu = CurrentProject.Path & "\arşiv" & "\" & BelgeAdi
bu şekidle yapınca oldu. kusura bakmayın aceleci davrandım
derzulya, proud to be a member of AccessTr.neT since 09-03-2009.
Cevapla
#6
access de tutar kısmını biçimlendirdiğim için örneğin 2.751.545,00 olarak görünüyor. ama worde attığında 2750545 olarak yazıyor. bunun wordde de para birimi olarak görünmesini nasıl sağlarım.
derzulya, proud to be a member of AccessTr.neT since 09-03-2009.
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task