Farklı kaydet ve geri dön

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Sub FolderExistsArsiv()
Dim TargetFolder As String
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
Set s3 = Sheets("devirler")
Set s4 = Sheets("Aylık")
Set fs = CreateObject("Scripting.FileSystemObject")
a = WorksheetFunction.Text(s1.Cells(1, 1), "yyyy")
b = WorksheetFunction.Text(s1.Cells(1, 1), "mmyyyy")
k_yol = ThisWorkbook.Path
k_ad = ThisWorkbook.Name
tarih = s1.Cells(1, 1)

'---------------Yıl
yol = ThisWorkbook.Path & "\" ' mevcut çalışma kitabının olduğu ve alt klasör açılacak yol
TargetFolder = yol & a         ' Açılacak klasör adı ile birleşimi
If Not fs.FolderExists(TargetFolder) Then        'KONTROL
ChDir yol: MkDir a: MsgBox a & " Klasörü oluşturuldu.!"  'klasöre git, oluşturma mesajı ver
'farklı kaydet
    ActiveWorkbook.SaveAs Filename:= _
    yol & a & "\" & b & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
'kaydedileni kapat

'...........................

'Aynı dosyaya Dön
    ChDir k_yol
    Workbooks.Open Filename:= _
        k_yol & "\" & k_ad
Else
MsgBox a & " Klasörü var!"   'var mesajı var
End If
End Sub
1) Arkadaşlar bu kodlarda kaydedilen çalışma sayfası nasıl kapatılır.
2) Farklı kaydet esnasında makroları ve a,b,b sayfaları hariç demenin yolu varmıdrı?

Saygılarımla
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
güncel... lütfen yardım edin yazmaya çalıştığım bir program var yarın kısmetse arkadaş gelecek ona tanıtacam
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Sub FolderExistsArsiv()
Dim TargetFolder As String
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
'Set s4 = Sheets("Sayfa4")
Set fs = CreateObject("Scripting.FileSystemObject")
a = WorksheetFunction.Text(s1.Cells(1, 1), "yyyy")
b = WorksheetFunction.Text(s1.Cells(1, 1), "mmyyyy")
k_yol = ThisWorkbook.Path
k_ad = ThisWorkbook.Name
tarih = s1.Cells(1, 1)

'---------------Yıl
yol = ThisWorkbook.Path & "\" ' mevcut çalışma kitabının olduğu ve alt klasör açılacak yol
TargetFolder = yol & a         ' Açılacak klasör adı ile birleşimi
If Not fs.FolderExists(TargetFolder) Then        'KONTROL
ChDir yol: MkDir a: MsgBox a & " Klasörü oluşturuldu.!"  'klasöre git, oluşturma mesajı ver
GoTo CalismasayfasıKontrol
Else
MsgBox a & " Klasörü var!"   'var mesajı var
End If

'--------------->>>>>>
Exit Sub
CalismasayfasıKontrol:
MsgBox "CalismasayfasıKontrol-e hoşgeldiniz"
'farklı kaydet
    ActiveWorkbook.SaveAs Filename:= _
    yol & a & "\" & b & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        farklıkaydet  denedim, ama tekrar dosya adı sordu
'Aynı dosyaya Dön
    ChDir k_yol
    Workbooks.Open Filename:= _
        k_yol & "\" & k_ad

'farklı kaydedileni kapat
    ck_adi = b & ".xls": Windows(ck_adi).Close
'...........................
End Sub
Sorun çözülmüştür.
 
Üst