Excelden Worde Veri Aktarma

[excel_198]

Merhaba arkadaşlar ;

Elimde excelde veri girilip worde oluşturan sözleşme metninin istediğimiz yerlere yapıştırmak
Bir örnekle acıklayalım örnekkler ektedir.

Yardımcı olduğunuz için Allah razı olsun...
Teşekkür ederim.

 

[excel_198]

Merhaba arkadaşlar ;

Elimde excelde veri girilip worde oluşturan sözleşme metninin istediğimiz yerlere yapıştırmak
Bir örnekle acıklayalım örnekkler ektedir.

Yardımcı olduğunuz için Allah razı olsun...
Teşekkür ederim.

Arkadaşlar yok mu içimizde bu sorunu çözebilecek ustadlarımız

 

[excel_198]

Merhaba Arkadaşlar

Sizlere sorum, ms word de hazır olan metinin istediğimiz yerlerine excelden veri gönderebilir miyiz ?

Örnegin 10 sayfalık sözleşme metnimiz var
Her sayfasında Ad soyad tc no gerekli biz bunu excelde tek yere girsek ve kendisi otomatikmen word de belirnenen yerlere ad soyad tc no otomatik olarak 10 sayfanın hepsine yapıştırabilir mi ?

Yardımlarınız çok teşekkür ederim.

 

[leumruk]

Merhaba,
Diğer başlığınızda eklediğiniz örnek dosyadan hareketle bir örnek hazırladım. Ayrıca diğer konudaki mesajlarınızı buraya taşıdım. Eklediğim klasörü rardan çıkarın ve oluşturduğunuz tablodaki isme çift tıklayarak sonucu gözlemleyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(3).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi", "tc_no", "adres", "mahalle", "tel_no")
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc"
For x = 1 To UBound(deg)
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection = Cells(Target.Row, x)
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"
End Sub

 

[excel_198]

Merhaba,
Diğer başlığınızda eklediğiniz örnek dosyadan hareketle bir örnek hazırladım. Ayrıca diğer konudaki mesajlarınızı buraya taşıdım. Eklediğim klasörü rardan çıkarın ve oluşturduğunuz tablodaki isme çift tıklayarak sonucu gözlemleyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(3).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi")
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc"
For x = 1 To 2
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection = Cells(Target.Row, x)
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(3).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi")
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc"
For x = 1 To 2
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection = Cells(Target.Row, x)
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"
End Sub

Sayın Mustafa Bey ;

Hocam çok çok teşekkür ederim,sizlerin sayesinde her geçen gün bişeyler öğreniyoruz. Vermiş olduğunuz emekler için çok saolun

Allah Razı Olsun

 

[excel_198]

Sayın leumruk bey emeğiniz için tekrar teşekkür ederim.Mesala yanındaki t.c no gibi bilgileride wordde istediğimiz yerlere gitmesi içinde ne yapabiliriz ? Bunun işlevlerini nasıl yapabilirim.
Çok Teşekkür Ederim

 

[leumruk]

Sayın leumruk bey emeğiniz için tekrar teşekkür ederim.Mesala yanındaki t.c no gibi bilgileride wordde istediğimiz yerlere gitmesi içinde ne yapabiliriz ? Bunun işlevlerini nasıl yapabilirim.
Çok Teşekkür Ederim

Hazırladığım kodun mantığını kısaca anlatıyorum:
Klasörde bulunan "sablon" isimli word dosyasında bulunan metinde Baba Adı metnini seçip Ekle>Yer İmi menüsünden "baba_adi" başlığıyla yer imi ekledim. Aynı işlemi Adı Soyadı kısmına "adi_soyadi" başlığıyla yaptım. Ardından Array ile bu yerimi isimlerini dizi içine aldım. Excelde yazdığım kodla "sablon" dosyasının açılmasını sağladım. Döngü kurarak yer imlerinin bulunduğu alana giderek ilgili metinlerin bu alanlara yazılmasını sağladım. Ardından farklı kaydet koduyla sablon dosyasını "yazdır" ismiyle kaydettim. Olay bu kadar basit.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(3).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi") 'Yer imlerinin bulunduğu dizi
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc" 'sablon dosyasını açan komut
For x = 1 To 2 'Yer imi sayısı kadar döngü
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x) 'Yer imine ulaşmayı sağlayan komut
wd.Selection = Cells(Target.Row, x) 'Döngü numarasındaki sütunda bulunan bilgiyi ilgili yere alan satır
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"'sablon dosyasını yazdır olarak kaydetmeye yareyen satır
End Sub

 

[excel_198]

Merhaba,
Diğer başlığınızda eklediğiniz örnek dosyadan hareketle bir örnek hazırladım. Ayrıca diğer konudaki mesajlarınızı buraya taşıdım. Eklediğim klasörü rardan çıkarın ve oluşturduğunuz tablodaki isme çift tıklayarak sonucu gözlemleyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(3).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi")
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc"
For x = 1 To 2
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection = Cells(Target.Row, x)
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"
End Sub

Sayın Mustafa ALTUN
Hocam emeğiniz ve ilginiz için sonsuz teşekkür ederim,sizler gibi hocalarımızın sayesinde çok şey öğreniyoruz .
Allah Razı Olsun
Teşekkür Ederim

 

[leumruk]

Sayın Mustafa ALTUN
Hocam emeğiniz ve ilginiz için sonsuz teşekkür ederim,sizler gibi hocalarımızın sayesinde çok şey öğreniyoruz .
Allah Razı Olsun
Teşekkür Ederim

Rica ederim. İyi çalışmalar.k::

 

[excel_198]

Excelden worde veri aktarımı hakkında

Sayın leumruk;
Hocam merhabalar tekrar ;
Kusura bakmayın sizleri sürekli rahatsız ediyorum bu aralar .
Hocam yapmış oldugunuz kodları bende yaptım çalıştırdım. Yenisini oluşturdum yapıyor , buraya kadar sorun yok.

Takıldığım bir yer şurası aşağıdaki "array" komutunda 5 adet belirtilen yer imi ile çalışıyor. Ancak yer imi sayısı 6 adet olunca verilen hata ;
"run time error 5101 - böyle bir yer işareti yok"
vba penceresinde sarı ile şu kodu boyuyor.
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)

"Kodlar"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("b2:b" & [b65536].End(4).Row)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Cancel = True
deg = Array("", "baba_adi", "adi_soyadi", "mah", "pafta", "ada")
yol = ThisWorkbook.Path
Set wd = CreateObject("word.Application")
wd.Visible = True
wd.Application.Documents.Open yol & "\" & "sablon.doc"
For x = 1 To 5
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)
wd.Selection = Cells(Target.Row, x)
Next
Set WDDoc = wd.ActiveDocument
WDDoc.SaveAs yol & "\" & "yazdır" & ".doc"
End Sub

 

[leumruk]

Merhaba,
Aslında hata mesajı nerede hata yaptığınızı açıkça söylemiş... "sablon" dosyasında yer imlerinden birini tanımlamamış olmalısınız. Hata verdiğinde debug'a tıklayın ve kod sayfası açıldığında mause ile x yazan kısımlardan birinin üzerine gidin. Bu kaçıncı döngüde olduğunuzu öğrenmenizi sağlayacaktır. Çıkan sonuca göre o sırada bulunan yer iminden kaynaklanan bir hata var demektir. "sablon" dosyasından bu yer imini tanımlayıp tanımlamadığınızı kontrol edin.

 

[hasankarahs]

merhaba,
ben çok acemiyim de hocam aradaki farkı görebilmemem için üç yer imi içeren bir örnek gönderebilir misiniz? VBA yı ilk kez burda gördüğüm için hiç bi bilgim yok. ayrıca yer imi nasıl tanımlanıyor söylerseniz senvinirim =)
Şimdiden teşekkürler

 

[leumruk]

merhaba,
ben çok acemiyim de hocam aradaki farkı görebilmemem için üç yer imi içeren bir örnek gönderebilir misiniz? VBA yı ilk kez burda gördüğüm için hiç bi bilgim yok. ayrıca yer imi nasıl tanımlanıyor söylerseniz senvinirim =)
Şimdiden teşekkürler

Merhaba,
Dördüncü mesajda örnek dosya var. Yedinci mesajda açıklaması var. Açıklamalarda yer iminin nasıl oluşturulduğunuda belirttim. Ek olarak şunu belirteyim: Yer imini oluşturmadan önce imleci yer imi oluşturmak istediğiniz kısma getireceksiniz.
4 nolu mesajdaki örneği güncelledim. Örnek dosyada 6 tane yer imi var ve exceldeki tüm bilgileri word dosyasının belirlediğim kısmına ekliyor. Kırmızı satır yer imlerinin adlarının yazdığı kısım. Unutmayın sablon dosyasında yer imi oluşturacaksınız.

 

[valid20]

Hata mesajı

Merhabalar tam aradığım şeyi yayınlamışsınız teşkkür ederim. Ama bende excel dosyasında verilerden birinin üzerine tıklayınca, Microsoft visual baci açılıp:
Compile Error:
Can't find project or library.
diye bir mesaj alıyorum. Programcılık bilgim yok o nedenle bana yardımcı olursanız sevinirim.
Teşekkür ederim.

 

[leumruk]

Merhabalar tam aradığım şeyi yayınlamışsınız teşkkür ederim. Ama bende excel dosyasında verilerden birinin üzerine tıklayınca, Microsoft visual baci açılıp:
Compile Error:
Can't find project or library.
diye bir mesaj alıyorum. Programcılık bilgim yok o nedenle bana yardımcı olursanız sevinirim.
Teşekkür ederim.

Visual_Basic Düzenleyicisini açın, Tools>References kısmında iaşretli referanslardan Missing ile başlayan var mı bana bilgi verin.
Ayrıca hata mesajı aldığınızda debug'a tıklayarak hataya sebep olan satırı buraya ekleyin, inceleyelim.

 

[mustam]

Sutun atlatma nasıl oluyor.

Merhaba,

Bu VB kodu çok işime yaradı. Tek takıldığım konu transfer etmek istemediği sutunu nasıl atlata bilirim ? Mesela aşağıda tarih sutununu transfer olmasını istemiyorum.

deg = Array("", "tarih", "gemi", "liman", "firma", "hat", "ref", "saha", "konteyner")

Yardımcı olursanız sevinirim.

Saygılarımla,

 

[Skorpiyon]

Sayın mustam,

For x = 1 To 7 'x için 1den 7ye kadar say
wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x) 'Word, yer imi 1'in değerine
wd.Selection = Cells(Target.Row, x) 'excelde belirtilen satır, sütundaki bilgiyi yaz
Next 'döngüyü tekrarla.

x harfi, verinin hangi sütundan alınacağını ifade ediyor. Yani, hedef satırın, x'nci sütunu.

Siz, tarih bulunan satır kaçıncı sütunda ise, 1 fazlasını yazın.

Örneğin, tarihin 1.sütunda olduğunu varsayarsak, kod şu şekilde olurdu.
wd.Selection = Cells(Target.Row, x+1)

 

[cimcoz]

Nasıl Yaparım?

Sayın leumruk,

Bu yazdırma olayı gerçekten mükemmel olmuş.
Aşağıdaki sorum için yardımınzı rica ederim;
yazdır.doc yerine her yaratılan dosyaya ilgili satırın bir hücresindeki adı vermek istiyorum

WDDoc.SaveAs yol & "\" & [G2] & ".doc"
alanındaki G2 yerine bastığım satırın "G" hücresindeki değeri alıp dosya adı yapmam için bu kodu nasıl değiştirmem gerekiyor.
Yani 2. satırda G2, 3. satırda G3... hücrelerinden save edilecek dosya adlarını aldırmam için?

Yardımınız için şimdiden teşekkürler..

Cimcoz

 

[leumruk]

Merhaba,
Aşağıdaki gibi deneyin:

WDDoc.SaveAs yol & "\" & Range("g" & ActiveCell.Row).Text & ".doc"

 

[Mustafa MUTLU]

Visual_Basic Düzenleyicisini açın, Tools>References kısmında iaşretli referanslardan Missing ile başlayan var mı bana bilgi verin.
Ayrıca hata mesajı aldığınızda debug'a tıklayarak hataya sebep olan satırı buraya ekleyin, inceleyelim.

Sayın Hocam
Denedim

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Missingle başlayan işaretliyken veriyor
işareti kaldırdım
Koddaki,

wd.Selection.GoTo What:=wdGoToBookmark, Name:=deg(x)

Bu satır hata verdi..
x in üzerine gelince
x=1 gösteriyor.

Hata da Böyle bir yer işareti yok diyor.