• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel' de Farklı Kaydet işlemi

Katılım
6 Temmuz 2007
Mesajlar
56
Excel Vers. ve Dili
Office 365
Değerli Üstadlarım,

Çok basit bir excel örneğim var ama örneğimde bulunan farklı kaydet butonu için bir türlü aradığım yada bana yakın olan bir kod bulamadım. Yukarı çevir aşağı indir bir türlü işin içinden çıkamadım.
Buton un yapmasını istediğim olay kısaca burda anlatayım.
Excel in kendisinde bulunan farklı kaydet butonunu seçtiğim zaman belirlemiş olduğum hücrenin içindeki sayı bir artarak devam ediyor ama dosya ismini kendim yazmam gerekiyor. Dosya ismi ile uğraşmamak için bende bir adet buton ekledim. Bu buton sayesinde belirli hücrelerin içerisinde bulunan bilgileri alarak dosyaya farklı isimle kayıt ediyor ama bu sefer artarak giden sayı artmıyor.
Şayet Örneğimi incelerseniz herhalde o zaman daha anlaşılır olur.

Şimdiden değerli üstadlarımın ellerine sağlık,
 

Ekli dosyalar

Değerli Üstadlarım,

Çok basit bir excel örneğim var ama örneğimde bulunan farklı kaydet butonu için bir türlü aradığım yada bana yakın olan bir kod bulamadım. Yukarı çevir aşağı indir bir türlü işin içinden çıkamadım.
Buton un yapmasını istediğim olay kısaca burda anlatayım.
Excel in kendisinde bulunan farklı kaydet butonunu seçtiğim zaman belirlemiş olduğum hücrenin içindeki sayı bir artarak devam ediyor ama dosya ismini kendim yazmam gerekiyor. Dosya ismi ile uğraşmamak için bende bir adet buton ekledim. Bu buton sayesinde belirli hücrelerin içerisinde bulunan bilgileri alarak dosyaya farklı isimle kayıt ediyor ama bu sefer artarak giden sayı artmıyor.
Şayet Örneğimi incelerseniz herhalde o zaman daha anlaşılır olur.

Şimdiden değerli üstadlarımın ellerine sağlık,

Bunu denermisiniz.

Kod:
Private Sub CommandButton1_Click()
Dosya_adi = Cells(8, "I").Value & "_" & Cells(6, "BF").Value & "_" & Cells(5, "BC").Value
Sayfa_adi = "Sayfa1"
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
 
[COLOR=red]If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"[/COLOR]
 
[COLOR=red][/COLOR]
Sheets(ActiveSheet.Name).Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adi
ActiveWorkbook.SaveAs Kaynak & Dosya_adi & Uzanti
ActiveWorkbook.Close False
Cells(6, "BF").Value = Cells(6, "BF").Value + 1
MsgBox "işlem tamam.?", vbInformation, "uyarı!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
 
Ellerinize sağlık Halit3

Bunu denermisiniz.

Kod:
Private Sub CommandButton1_Click()
Dosya_adi = Cells(8, "I").Value & "_" & Cells(6, "BF").Value & "_" & Cells(5, "BC").Value
Sayfa_adi = "Sayfa1"
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
Sheets(ActiveSheet.Name).Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adi
ActiveWorkbook.SaveAs Kaynak & Dosya_adi & Uzanti
ActiveWorkbook.Close False
Cells(6, "BF").Value = Cells(6, "BF").Value + 1
MsgBox "işlem tamam.?", vbInformation, "uyarı!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

Halit Bey ellerinize sağlık çok güzel oldu ama yalnız şöyle bir problemim oluştu.
Kayıt ederken dosyayı seçiyorum ama o dosyanın içine atmıyor sadece o dosyanın ismini başına alarak bir üst dosyaya atıyor.
Örnek:
C:\Documents and Settings\HDF - Finans\Belgelerim\Data Base\Teklifler\Firma dosyasının içine atmasını istiyorum ama işlemi C:\Documents and Settings\HDF - Finans\Belgelerim\Data Base\Teklifler\ dosyasına başına Firma diyerek atıyor.
Aceba nerde hata yapıyorum.

Şimdiden ellerinize sağlık...
 

Ekli dosyalar

Halit Bey ellerinize sağlık çok güzel oldu ama yalnız şöyle bir problemim oluştu.
Kayıt ederken dosyayı seçiyorum ama o dosyanın içine atmıyor sadece o dosyanın ismini başına alarak bir üst dosyaya atıyor.
Örnek:
C:\Documents and Settings\HDF - Finans\Belgelerim\Data Base\Teklifler\Firma dosyasının içine atmasını istiyorum ama işlemi C:\Documents and Settings\HDF - Finans\Belgelerim\Data Base\Teklifler\ dosyasına başına Firma diyerek atıyor.
Aceba nerde hata yapıyorum.

Şimdiden ellerinize sağlık...

Yukarıdaki mesajdaki kodu düzelttim.
 
halit uzmanım tekrar tekrar ellerine sağlık
şayet seni fazla sıkmıyorsam son birşey daha öğrenmek isterim senden.
Kayıt ederken şu şekilde bir yazı çıkıyor karşıma onu engelleme gibi yada bu yazı çıkmadan kayıt etme imkanım var mı?
Çıkan yazı şöyle...:
Aşağıdaki özellikler makro içermeyen çalışma kitaplarına kaydedilemez:
*VB projesi
Dosyayı bu özelliklerde kaydetmek için, Hayır' ı tıklatın ve ardından Dosya Türü listesinde makro özelliği etkinleştirilmiş bir dosya türü seçin.
Makro içermeyen çalışma kitabı olarak kaydetmeye devam etmek için, Evet' i tıklatın.

Not.: Önemli bir şey midir bu yazı?
 
halit uzmanım tekrar tekrar ellerine sağlık
şayet seni fazla sıkmıyorsam son birşey daha öğrenmek isterim senden.
Kayıt ederken şu şekilde bir yazı çıkıyor karşıma onu engelleme gibi yada bu yazı çıkmadan kayıt etme imkanım var mı?
Çıkan yazı şöyle...:
Aşağıdaki özellikler makro içermeyen çalışma kitaplarına kaydedilemez:
*VB projesi
Dosyayı bu özelliklerde kaydetmek için, Hayır' ı tıklatın ve ardından Dosya Türü listesinde makro özelliği etkinleştirilmiş bir dosya türü seçin.
Makro içermeyen çalışma kitabı olarak kaydetmeye devam etmek için, Evet' i tıklatın.

Not.: Önemli bir şey midir bu yazı?

Kullanıcı panelinizde ofis 2003 kullandığınız yazıyor oysa bu aldığınız hatalar ofis 2007 veya daha üstünde çıkar

kodu yeniden düzenledim.

Kod:
Private Sub CommandButton1_Click()
Dosya_adi = Cells(8, "I").Value & "_" & Cells(6, "BF").Value & "_" & Cells(5, "BC").Value
Sayfa_adi = "Sayfa1"
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
If Uzanti = ".xls" Then
FileFormatNum = -4143
ElseIf Uzanti = ".xlsm" Then
FileFormatNum = 52
ElseIf Uzanti = ".xlsx" Then
FileFormatNum = 51
ElseIf Uzanti = ".xlsb" Then
FileFormatNum = 50
Else
FileFormatNum = 56
End If
Sheets(ActiveSheet.Name).Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adi
ActiveWorkbook.SaveAs Kaynak & Dosya_adi & Uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close False
Cells(6, "BF").Value = Cells(6, "BF").Value + 1
MsgBox "işlem tamam.?", vbInformation, "uyarı!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
 
Ellerine sağlık halit3 uzmanım
2003 evde kullanıyorum işyerinde 2007 o yüzden karıştı.

Emeğinize ve ilginize çok çok teşekkür ederim
 
Ellerine sağlık halit3 uzmanım
2003 evde kullanıyorum işyerinde 2007 o yüzden karıştı.

Emeğinize ve ilginize çok çok teşekkür ederim

İyi çalışmalar
 
Geri
Üst