Farklı Formatta Kaydetme Sorunu

[cihantopuz]

Benim Sorunum 2 ayrı aşamadan oluşuyor.
1. Aşaması yalnızca belirli sayfaları (Seçtiğim 2 sayfayı ki seçimin ikisi sabit sayfa iken bir tanesi değişken sayfa (değişken sayfa Örnekte Sabitler E1 hücresine yazılı sayfa sabit sayfa ise mlz_list sayfası) dışında kalan bütün sayfaları silecek bir kod. (Diğer sayfalara başvuran hücreler var onları ben halledeceğim )

2. Ve zor olanı: seçili alanı worde aktarıp benim istediğim isimle (Örnekte sabitler g1 deki isimle) istediğim yere kaydedecek ve excele dönecek bir kod. Forumda bu aktarım ile ilgili örnekler buldum ve denedim ama bir türlü tam isediğimi başaramadım. Bu word olmazsa htm &html olursa da olur.


yalnız önemli bişii daha var ben dökümanı htm yada html olarak kaydettiğimde seçimim dışında sayfalarda geliyor ben seçtiğim 1 sayfayı (Örnekte sabitler g1 deki isimle) kaydetmek istiyorum.

İçerisinde sql sorguları olduğundan makroları etkinleştirerek kendi bilgisayarınızda çalıştıramayacaksınız. Makroları devre dışı bırakarak açınız.
Excel göster şifresi : x

Bu işlemi ise userform_ti üzerindeki havuza gönder ve ilana gönder butonları vasıtası ile yapmak istiyorum.

edit: ekli dosya sorun çözüldüğü için kaldırılmıştır

 

[cihantopuz]

yalnız önemli bişii daha var ben dökümanı htm yada html olarak kaydettiğimde seçimim dışında sayfalarda geliyor ben seçtiğim 1 sayfayı (Örnekte sabitler g1 deki isimle) kaydetmek istiyorum.

 

[cihantopuz]

sorunu aşağıda kodlarını verdiğim şekilde çzömeyi başardım. ya da istediğimi yaptım diyelim. Ancak seçtiğim 2 sayfanın html olarak (istediğim isimle) kaydedilmesini sağlayabilsem daha iyi olacak
Sub Worde_at()
fName = Worksheets("Sabitler").range("g4").Value'Mevcut Dosyanın Adı Alınıyor fname değişkeni olarak tanımlanıyor
If fName <> 0 Then
range("A11:K18").Copy 'aktif Teklif isteme sayfasının üst metni kopyalanıyor
Set objword = CreateObject("Word.Application")'Word uygulaması açılıyor
objword.Visible = True
Set MyDoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)'Yeni Belge açılıyor
objword.Selection.PasteSpecial Link:=False, DataType:=2 'aktif Teklif isteme sayfasının üst metni biçimlendirmeler olmadan yapıştırılıyor (datatype2=)
range("A28:K57").Copy 'aktif Teklif isteme sayfasının alt metni kopyalanıyor
objword.Selection.PasteSpecial Link:=False, DataType:=2'aktif Teklif isteme sayfasının alt metni biçimlendirmeler olmadan yapıştırılıyor (datatype2=)
Sheets("mlz_list").Select
dolu_sec 'malzeme listesindeki aktif dolu hücreler seçiliyor
Selection.Copy 'malzeme listesindeki aktif dolu hücreler kopyalanıyor
objword.Selection.PasteSpecial Link:=False, DataType:=10 'malzeme listesindeki verilerde worde aktarılıyor Biçimlendirmeleri ile birlikte (datatype=10)
objword.activedocument.SaveAs "C:\" & fName & ".doc"'Word Belgesi belirlediğimiz isimle belirlediğimiz yere kaydediliyor.
objword.Quit 'Wordden çıkılıyor
End If
End Sub

Sub dolu_sec()
Range(ActiveCell, ActiveCell.End(xlDown)).Select
'Üstteki hücreler için aynı işlemi yapar.
Range(ActiveCell, ActiveCell.End(xlUp)).Select
'Sağdaki hücreler için aynı işlemi yapar.
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
'Soldaki hücreler için aynı işlemi yapar.
Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
'Aktif hücrenin etrafındaki dolu hücreleri seçer.
ActiveCell.CurrentRegion.Select
End Sub