Excel'den Word'e aktarmada hata

[cevdetmeric1]

Merhaba arkadaşlar,
Exceldeki her satır için bir word dosyası oluşturuyorum. Hepsi güzel şekilde çalışıyor. Ama dosyayı farklı kaydet dediğim zaman hata veriyor. Dosya adına baktığım zaman doğru adı alıyor. Yada dosyayı sadece kaydet dersem bana kayıt yapmak için soruyor. Tek sorun farklı kaydetmede.
Yardımlarınız için teşekür ediyorum.

Private Sub CommandButton1_Click()
Range("k22") = Cells(5, 7)
Range("k27") = Cells(5, 7)
For I = 2 To 100 'WorksheetFunction.CountA(Range("D")
If Cells(I, 3) = "" Then
Exit Sub
Else
Range("M5") = Cells(I, 3)
Range("M27") = Cells(I, 5)
Range("O27") = Cells(I, 6)

Range("J1:R29").Select
Selection.Copy
Set WD = CreateObject("Word.Application")
WD.Visible = True
Set dosya = WD.Documents.Add(DocumentType:=wdNewBlankDocument)
With WD.Selection.PageSetup
.TopMargin = WD.CentimetersToPoints(1)
.BottomMargin = WD.CentimetersToPoints(1)
.LeftMargin = WD.CentimetersToPoints(1)
.RightMargin = WD.CentimetersToPoints(1)
End With



WD.Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
:=wdInLine, DisplayAsIcon:=False
Application.CutCopyMode = False

dosya = Range("M5").Value & ".doc"
yol = ThisWorkbook.Path & "\"
With Application
.DisplayAlerts = False
WD.Documents.SaveAs (yol & dosya)
.DisplayAlerts = True
End With

End If
Next I
End Sub

 

[mancubus]

Documents bir kolleksiyondur. word dosyalarını içerir.

kolleksiyona ait bir word doyasını kaydetmek lazım gelir.

ActiveDocument gibi.



____________________
öte yandan kodu buraya kopyaladıktan sonra tamamını tarayıp cevap panelindeki # düğmesine tıklarsanız kodu forum kurallarına uygun ve daha rahat okunabilir şekilde buraya aktarmış olursunuz.
____________________
.
.
.

 

[cevdetmeric1]

Yeni dosyayı active document olarak mı göstermem mi gerekir? Nasıl yapmalıyım?

 

[mancubus]

ben bu işi yapacak olsa idim, yani, C2'den başlayarak C sütunundaki son dolu hücreye kadar, eğer hücre boş değilse, bir kaç hücre verisi değişmek kaydı ile tanımlanan aralığı word'de boş dosyaya resim olarak kopyalayıp her bir işlemi ayrı bir word dosyası olarak kaydedecek olsa idim aşağıdaki gibi bir kod kullanırdım.

Sub defalarce_word_e()

    Dim calc As Long

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With

    Range("K22") = Cells(5, 7)
    Range("K27") = Cells(5, 7)
    
    For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
        If Range("C" & i) <> "" Then
            Range("M5") = Cells(i, 3)
            Range("M27") = Cells(i, 5)
            Range("O27") = Cells(i, 6)
            Range("J1:R29").Copy
            With CreateObject("Word.Document")
                With .PageSetup
                    .TopMargin = .Application.CentimetersToPoints(1) 'tüm marjlar aynı olduğu için:
                    .BottomMargin = .TopMargin
                    .LeftMargin = .TopMargin
                    .RightMargin = .TopMargin
                End With
                .Content.PasteSpecial DataType:=wdPasteOLEObject
                .SaveAs (ThisWorkbook.Path & "\" & Range("M5").Value & ".doc")
            End With
            Application.CutCopyMode = False
        End If
    Next i

    With Application
        .EnableEvents = True
        .Calculation = calc
    End With
End Sub

 

[cevdetmeric1]

Teşekkür ediyorum.
elinize sağlık

 

[mancubus]

rica ederim. kolay gelsin.