Tablodaki verilerden dosya oluşturma

[hureyre84]

Merhabalar. Benim çok uzun bir tablom var ve bu tablodaki her kişiden bir word dosyası oluşturmak istiyorum.
A sütununda sicil no
B sütununda adı soy adı var

ben a sütunundaki verinin dosya adı olmasını istiyorum

Örnek : 1458.doc gibi
Yardımcı olursanız çok teşekkür ederim. Saygılarımla

 

[turist]

Sayın @hureyre84

Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/
bakınız

 

[hureyre84]

Sayın @hureyre84

Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/
bakınız

https://drive.google.com/open?id=1Xq05IqqbrFk0UCxqNs1cs-2fggBqIa7o
Tabloda sicil no yazan sütundaki her kişi için bir word dosyanın oluşmasını istiyorum. bu işlem makroyla tek seferde yapılması lazım.
yani o isimde boş bir word dosyası oluşturmalı.

 

[Haluk]

Şöyle olabilir ...

Koddaki 6 değerini, A sütunundaki en son verinin olduğu satır numarası ile değiştirirsiniz....

Sub Test()
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    For i = 2 To 6
        Set objWdFile = objWord.documents.Add
        objWdFile.SaveAs ThisWorkbook.Path & Application.PathSeparator & Range("A" & i).Text & ".docx"
        objWdFile.Close
    Next
    objWord.Quit
    Set objWdFile = Nothing
    Set objWord = Nothing
End Sub

.

 

[turist]

https://drive.google.com/open?id=1Xq05IqqbrFk0UCxqNs1cs-2fggBqIa7o
Tabloda sicil no yazan sütundaki her kişi için bir word dosyanın oluşmasını istiyorum. bu işlem makroyla tek seferde yapılması lazım.
yani o isimde boş bir word dosyası oluşturmalı.

Öneğinize göre uygulama yapılan dosya linki aşağıdadır.
İnceleyiniz.
https://www.dosyaupload.com/ebud

 

[hureyre84]

Öneğinize göre uygulama yapılan dosya linki aşağıdadır.
İnceleyiniz.
https://www.dosyaupload.com/ebud

Öneğinize göre uygulama yapılan dosya linki aşağıdadır.
İnceleyiniz.
https://www.dosyaupload.com/ebud[/QUO
Bende böyle bir uyarı verdi ama nedenini anlayamadım

"Can't find project or library"
birde dosyaları kaydedeceği klasör yolunu ekledim doğru mu yaptım acaba. Kodları yazıyorum bir bakar mısınız.

Private Sub CommandButton1_Click()
Dim sonsatir As Long
Dim sicilno As Range
Dim WordBelgesi As Word.Application
Dim dosyayolu As String
Set WordBelgesi = CreateObject("Word.Application")
dosyayolu = ThisWorkbook.Path & "D:\PERSONEL DOSYALARI\"
With ActiveSheet
    sonsatir = .Range("A65500").End(xlUp).Row
    For Each sicilno In Range("A2:A" & sonsatir)
        If sicilno_Offset(0, 2).Hyperlinks.Count = 0 Then
            With WordBelgesi
                .Documents.Add
                .Documents(.Documents.Count).SaveAs Filename:=dosyayolu & sicilno.Text & ".docx"
                .Documents(sicilno.Text & ".docx").Close SaveChanges:=wdSaveChanges
            End With
            sicilno_Offset(0, 2).Value = sicilno.Text & "  Word Dosyasını Aç"
            sicilno_Offset(0, 2).Hyperlinks.Add Anchor:=sicilno_Offset(0, 2), Address:=dosyayolu & sicilno.Text & ".docx"
        End If
    Next sicilno
    Range("C2:C" & sonsatir).Columns.AutoFit
End With
End Sub
[

uyarı verdiğinde bu satırı işaretliyor
Dim WordBelgesi As Word.Application
birde listeye isim eklediğimde "dll" hatası veriyor. Kodlar hiç açılmıyor.

 

[hureyre84]

Şöyle olabilir ...

Koddaki 6 değerini, A sütunundaki en son verinin olduğu satır numarası ile değiştirirsiniz....

Sub Test()
    Dim objWord As Object
    Set objWord = CreateObject("Word.Application")
    For i = 2 To 6
        Set objWdFile = objWord.documents.Add
        objWdFile.SaveAs ThisWorkbook.Path & Application.PathSeparator & Range("A" & i).Text & ".docx"
        objWdFile.Close
    Next
    objWord.Quit
    Set objWdFile = Nothing
    Set objWord = Nothing
End Sub

.

çok teşekkür ederim işe yaradı

 

[turist]

uyarı verdiğinde bu satırı işaretliyor
Dim WordBelgesi As Word.Application
birde listeye isim eklediğimde "dll" hatası veriyor. Kodlar hiç açılmıyor.

Dosyanızın Linki
Bu şekliyle deneyin.

 

[hureyre84]

Dosyanızın Linki
Bu şekliyle deneyin.

ÇOK TEŞEKKÜR EDERİM BU SEFER MÜKEMMEL OLDU. ELLERİNİZE SAĞLIK

HERKEZDEN YARDIMLARINDAN DOLAYI TEŞEKKÜRLER EDERİM.

 

[turist]

ÇOK TEŞEKKÜR EDERİM BU SEFER MÜKEMMEL OLDU. ELLERİNİZE SAĞLIK

HERKEZDEN YARDIMLARINDAN DOLAYI TEŞEKKÜRLER EDERİM.

Sağ olun.