Aşağıdaki kod malumunuz olduğu gibi excel den word belgesine resim atan bir kod ancak sayfalar hep dikey oluyor benim amacım açılan word sayfalarının yatay olmasını sağlamak. Bunun için bu kodun neresinde değişiklik yapmam lazım. Şimdiden yardımlarınız ve desteklerinin için teşekkür ederim. (Bu siteden sayın "l e u m r u k" hocamızın bir çalışmasıdır.)
Sub Düğme18_Tıklat()
Set s1 = Sheets("SAYFALAR")
Set s2 = Sheets("YatirimButcesi")
yol = ThisWorkbook.Path & "\Tablolar\"
Application.ScreenUpdating = False
Set wd = CreateObject("Word.Application")
Set wddoc = wd.Documents.Add(DocumentType:=0)
wd.Visible = False
For x = 1 To s1.Cells(Rows.Count, 1).End(1).Row
If s1.Cells(x, 1) = "1" Then
s2.[z9] = s1.Cells(x, 1)
s2.Range("b38").CopyPicture
wd.ActiveDocument.Bookmarks("\page").Range.Delete
wd.Selection.Paste
wddoc.SaveAs yol & s1.[b1].Text & "-" & Format(Now, "dd.mm.yyyy hh_mm_ss") & ".doc"
End If
Next
wd.Visible = True
wddoc.Application.Quit
Application.CutCopyMode = False
Application.ScreenUpdating = True
'MsgBox "İşlem tamamlandı.", vbInformation, "l e u m r u k"
End Sub
Sub Düğme18_Tıklat()
Set s1 = Sheets("SAYFALAR")
Set s2 = Sheets("YatirimButcesi")
yol = ThisWorkbook.Path & "\Tablolar\"
Application.ScreenUpdating = False
Set wd = CreateObject("Word.Application")
Set wddoc = wd.Documents.Add(DocumentType:=0)
wd.Visible = False
For x = 1 To s1.Cells(Rows.Count, 1).End(1).Row
If s1.Cells(x, 1) = "1" Then
s2.[z9] = s1.Cells(x, 1)
s2.Range("b38").CopyPicture
wd.ActiveDocument.Bookmarks("\page").Range.Delete
wd.Selection.Paste
wddoc.SaveAs yol & s1.[b1].Text & "-" & Format(Now, "dd.mm.yyyy hh_mm_ss") & ".doc"
End If
Next
wd.Visible = True
wddoc.Application.Quit
Application.CutCopyMode = False
Application.ScreenUpdating = True
'MsgBox "İşlem tamamlandı.", vbInformation, "l e u m r u k"
End Sub
Son düzenleme: