farklı kaydet

[thugangel]

öncelikle çok teşekkür ederim.
ekte gönderdiğim dosyada yapmak istediklerimi açıklamaya çalıştım.forumu inceledim,bir sürü makro denedim ama olmadı.mutlaka biyerde hata verdi.umarım sizler bana yardımcı olursunuz.

 

[Emir Hüseyin Çoban]

3 - YENİ KAYDEDİLEN DOSYA, İSMİNİ BU SAYFADAKİ O8 HÜCRESİNDEN ALMALI (11/507-30619)

Merhaba, dosya ve klasörler isimlerinde \ / : ? * <>| karakterlerini kullanamazsınız.

 

[thugangel]

sondaki 30619'u alabilirmi

 

[thugangel]

ismini başka bir hücreden alsa da olur.formül olarak parçaal işlemini yaptırıp sonra özel yapıştırla değerleri seçerek yapıştır desek olabilir mi?

 

[thugangel]

ismini 'O' 11 hücresinden alsa da olur.ama yanına her seferinde artan bir numara verebilir mi?
yani 168 olarak ismini kaydetti.bir sonrakinde 168-2 , 168-3 diye arttırarak kaydebilir mi?

 

[thugangel]

hatta 11-507-30619 diye yazabilirim. o zaman sorun olmaz sanırım

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sayfayikaydet()
klasor = ThisWorkbook.Path
Set s1 = Sheets("TEKLİF")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
s1.Copy
If Val(Application.Version) > 11 Then
ActiveWorkbook.SaveAs Filename:=klasor & "\" & Replace(s1.[o8], "/", "-") & ".xls", FileFormat:=xlExcel8
Else
ActiveWorkbook.SaveAs Filename:=klasor & "\" & Replace(s1.[o8], "/", "-") & ".xls"
End If
ActiveSheet.DrawingObjects.Delete
ActiveSheet.Range([t:t], [t:t].End(xlToRight)).Clear
ActiveSheet.Range([t:t], [t:t].End(xlToRight)).EntireColumn.Hidden = True
ActiveSheet.Range([56:56], [56:56].End(xlDown)).Clear
ActiveSheet.Range([56:56], [56:56].End(xlDown)).EntireRow.Hidden = True
For Each modul In ActiveWorkbook.VBProject.VBComponents
Set modul = ActiveWorkbook.VBProject.VBComponents(modul.Name)
If modul.Type = 100 Then
Set kodmodul = modul.CodeModule
modul.CodeModule.DeleteLines 1, kodmodul.CountOfLines
End If
Next
ActiveSheet.Cells.Locked = True
ActiveSheet.[o8:s11].Locked = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
ActiveWorkbook.Close True
Application.ScreenUpdating = True
End Sub

 

[thugangel]

cevap için teşekkürler

 

[thugangel]

elinize sağlık çok süper oldu. yalnız bir sorum dahaolacak. kaydetme yeri olarak belirlediğim yerdeki bir klasörü verebilirmiyim?

 

[Levent Menteşoğlu]

elinize sağlık çok süper oldu. yalnız bir sorum dahaolacak. kaydetme yeri olarak belirlediğim yerdeki bir klasörü verebilirmiyim?

Aşağıdaki satırda klasörü tanımlayabilirsiniz. ThisWorkbook.Path yerine klasör yolunu yazın.

klasor = ThisWorkbook.Path

 

[thugangel]

çoook teşekkür ederim.elleriniz dert görmesin

 

[thugangel]

çook süper oldu.ancak affınıza sığınarak bir sorum daha olacak. sayfada şirket logosu ve küçük bir resim var ancak makroyla farklı kaydedilen sayfada çıkmıyor. yardım ederseniz sevinirim

 

[thugangel]

belirli bir hücre aralığındaki resmi silmek mümkün mü?