Word de doldurulan formu excel e aktarmak

[sakaryakazim]

arkadaşlar merhaba aşağıdaki linkteki dosyamda form isimli Word belgesine girdiğim belge no, adı soyadı, yaşı ve işaretli olan güvencesi alanını yine aynı dosyadaki Yaz isimli excel dosyasına aktarmak istiyorum manuel elle yaptım dikkat ederseniz ancak bu form günlük sürekli kullanılacağı için her doldurduğum formu bu excel tablosunun son satırına aktaracak bir makro arıyorum yardım edermisiniz
saygılarımla

http://www.dosya.tc/server38/DFgMHm/Yaz__m.rar.html

 

[monelogg]

Merhaba, pek de güzel bir şey olmadı (wordden hiç anlamadığımdan iyi bir sonuç çıkaramadım) fakat yardımcı olabileceğini düşünüyorum. Kodlar excelvba ve yabancı bir kaç siteden araştırarak yaptığım uyarlamadır.

Kod:

Private Sub Document_Open()
Dim Sorgu As String
Dim Bag As ADODB.Connection
Dim KS As ADODB.Recordset
Dim sds, bs As Long

sds = Range("A1048576").End(xlUp).Row
bs = sds + 1

Set Bag = New ADODB.Connection
Set KS = New ADODB.Recordset
Yol = "Provider=Microsoft.Jet.OLEDB.4.0;"
Yol = Yol & "Data Source=" & ThisWorkbook.Path & "\" & "yaz.xlsm;"
Yol = Yol & "Extended Properties=""Excel 8.0;HDR=No"";"
Bag.Open Yol
Sorgu = "SELECT * FROM [Sheet1$A2:A2]"
Set KS = Bag.Execute(Sorgu)

If Not KS.EOF Then
    C = KS.GetString
    Range("A" & bs) = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
    Range("B" & bs) = ActiveDocument.FormFields("Metin1").Result
    Range("C" & bs) = ActiveDocument.FormFields("Metin2").Result
    If ActiveDocument.FormFields("Check2").Result = True Then
        Range("D" & bs) = "Bağkurlu"
    ElseIf ActiveDocument.FormFields("Check1").Result = True Then
        Range("D" & bs) = "Sigortalı"
    ElseIf ActiveDocument.FormFields("Check1").Result = True Then
        Range("D" & bs) = "Özel Sağlık"
    End If
End If
Bag.Close
Set Bag = Nothing
Set KS = Nothing
End Sub

Dosya:
https://app.box.com/s/usfqgu0paj616jwylld5y4lgxj3qobr9

 

[sakaryakazim]

üstadım çok teşekkür ederim
wordden değil excelden olmuş olsun buda işimi görür
emeğine sağlık

 

[monelogg]

Rica ederim, yardımcı olduysa sevindim. Aslında word için de denedim fakat onu yapamadım.

 

[sakaryakazim]

oda olur inşallah