• DİKKAT

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

Dosyada bir makro kalsın diğerleri silinsin ve aynı isimle kaydedilerek kapatılsın.

L

lokman10

Katılım
8 Eylül 2011
Mesajlar
11
Excel Vers. ve Dili
2003
Merhaba
Makro1 kaydedilmedi
Öyle bir makro1 yazalım ki
makro2-3-4-5-6-7-8-9 u silsin
Yani diğer makrolar silinsin
sadece makro1 kalsın ve kaydedilerek kapatılsın

Böyle bir makro yazmada bana yardımcı olursanız
Çok memnun olurum
Şimdiden teşekkürler
 

Ekli dosyalar

İlginizden dolayı çok çok teşekkür ederim.
Linkleri inceledim. Aşağıda linkleri ve cevaba yönelik dosya adlarını yazdım.
Bu dosyaları indiremedim. Bunları güncellemeniz mümkün mü?
Aşağıda linkler cevaba yönelik Eklenmiş Dosyaları indiremiyorum.
Bunların güncellenmesi mümkün mü?
http://www.excel.web.tr/f48/makro-silen-makro-t51194.html
MakrolariSil.xls (23.5 KB, 45 Görüntülenme)

http://www.excel.web.tr/f48/farkly-...eni-dosyada-modul-veya-makrolaryn-t35643.html
FarkliKaydetteTumMakrolariSiler.zip (9.6 KB, 50 Görüntülenme)
ÖRNEK.rar (7.2 KB, 40 Görüntülenme)

http://www.excel.web.tr/f48/makro-silen-makro-t51194.html
MakrolariSil.xls (23.5 KB, 45 Görüntülenme)

Herşey gönlünüzce olsun.
 
Sub farklıkaydetmakrolarısil()

Dim vFilename As Variant
Dim wbActiveBook As Workbook
Dim oVBComp As Object
Dim oVBComps As Object

vFilename = Application.GetSaveAsFilename(filefilter:="Microso ft Excel Workbooks,*.xls", _
Title:="Save Copy Without Macros")

If vFilename = False Then Exit Sub

ActiveWorkbook.SaveCopyAs vFilename
Set wbActiveBook = Workbooks.Open(vFilename)
End Sub


Dosyayı sizin belirleyeceğiniz bir ad ile farklı kaydeder ve makroları siler ( kod formdan alıntıdır.)
 
lokman10' Alıntı:
Merhaba
Makro1 kaydedilmedi
Öyle bir makro1 yazalım ki
makro2-3-4-5-6-7-8-9 u silsin
Yani diğer makrolar silinsin
sadece makro1 kalsın ve kaydedilerek kapatılsın

Böyle bir makro yazmada bana yardımcı olursanız
Çok memnun olurum
Şimdiden teşekkürler
Genişletmek için tıkla ...

Merhaba küçük bir örnek çalışma yaptım. Tabi bu sizin excel bilgi seviyenize bağlı fazla mesajlaşmamak dileğiyle;

açıklama
1-kodları getir düğmesine tıkla
2-F sutünuna silmek istediğin makrolara (x) işareti koy
3-kod sil düğmesini tıkla

not: sizin örnek dosyanızda makro1 kodu yok
 

Ekli dosyalar

Sn. uyrdkl ve S.halit3
İlginizden dolayı çok teşekkür ederim. Sizden Allah razı olsun.
dene13.rar dosyasını ekledim. Mümkünse inceler misiniz
Herşey gönlünüzce olsun
 

Ekli dosyalar

lokman10' Alıntı:
Sn. uyrdkl ve S.halit3
İlginizden dolayı çok teşekkür ederim. Sizden Allah razı olsun.
dene13.rar dosyasını ekledim. Mümkünse inceler misiniz
Herşey gönlünüzce olsun
Genişletmek için tıkla ...

Mesajınızı buraya yazmanız daha iyi olacağını düşünüyorum zira benim kota sorunun var. Sorunuzu öğrenmek için dosyanızı indirmek gerekiyor.

Bana kalırsa sizin aradığınız dosyayı farklı kayıt etmek olmalı eger siz bütün makroları silip kayıt ederseniz dosyayı bir dahaki dosyayı açtığınızda bu silinen makrolar size lazım olmayacakmı.
 
"Bana kalırsa sizin aradığınız dosyayı farklı kayıt etmek olmalı eger siz bütün makroları silip kayıt ederseniz dosyayı bir dahaki dosyayı açtığınızda bu silinen makrolar size lazım olmayacakmı."

Dosyamın yedeği var, gerekirse kullanabileceğim.
ilk talebim (butonsuz olmalı)
Makro1 çalıştığında
Aktit dosyanın başına "a_" ekleyerek farklı kaydetmiş görünüyor
Makroları siliyor (eğer varsa 100 e kadar) görünüyor
Manuel kayıt yapıyor veya dosyayı kapatı tıkladığımda
" 123.xlsm dosyasında yaptığınız değişiklikleri kaydetmek istiyormusunuz ? "
komut mesajı çıkıyor
evet dersem makrosuz kaydetmiş oluyorum.
Ben Manuel kayıt yapmak istemiyorum,
makroları silinmiş bu haliyle makro komutlarıyla kayıt yaptıramıyorum
Aynı işi yani makroları silinmiş görülen bu dosyayı kaydetme işini
Makro1 in altına ilave edeceğim bir kod ile (Makro komutu ile) yaptırmak istiyorum.
Ama bir türlü yapamadım. Bu konuda bilen arkaşlardan yardım rica ediyorum.
Bu dosyada makro1 adıyla kayıtlı makro sonuna ne yazmam gerekiyor.
çözüme yönelik 2. alternatif talep (butonsuz olmalı)
Eğer yukarıdaki talebim olamıyorsa
Bu örnekte 9 makro var. ( Asıl dosyamda 100 den fazla makrom var)
Belki kaydedemeyişim hiç makro kalmadığı içindir diye düşünerek
sadece makro1 kalsın diğerleri silinsin istedim
Bu da çözüm olabilir
Ama nihayetinde dosya bu haliyle kaydedilip kapatılsın
Asıl derdim bu haliyle "yani makroları silinmiş haliyle kaydedip , kapatamamam.
makro1 in altınailave edilecek bir komut ile aktif dosyayı kaydetsin ve kapatsın.
Belki bu şekilde daha kolay olabilir.
Ben excel 2007 kullanıyorum
tüm makroları etkinleştir seçeneğini işaretli
"VBA projesi nesne modeli erişimine güven işaretli

Sub Makro1()
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & "a_" & ThisWorkbook.Name
Set VBProj = ThisWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
If VBComp.Type = 100 Then
Set CodeMod = VBComp.CodeModule
With CodeMod
.DeleteLines 1, .CountOfLines
End With
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
aktif dosyayı kaydet ve kapat komutu buraya yazılacak
End Sub
 
8 nolu mesajdaki linke baktınızmı.?
 
Ben şöyle birşey yaptım kayıt et düğmesine tıklayınca dosyanızın aynısından seçtiğiniz klasöre günün tarihi ve saati ile makrosuz yenibir dosya olarak kayıt ediyor.
 

Ekli dosyalar

Halit bey, değerli kardeşim
Sorunu gerçekten çözmüşsünüz, sizi kutuyorum.
Allah sizden razı olsun.
Günlerdir buraya takılıp kalmıştım. Şimdi çalışmama devam edebilirim.

Yalnız bir ricam daha olacak :
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)

Bu soruyu sormasa da onun yerine aşağıda yeri belli olan klasörü otomatik seçse olur mu?
ThisWorkbook.Path & "\" & "a_" & ThisWorkbook.Name

Bu arada ben hekimim.
Tıbbi konuda size elimden gelen her türlü desteği verebilirim.
Allah gerek etmesin ama ihtiyacınız olduğunda sizin yanınızda olduğumu bilmenizi istiyorum.
Uğraştığım konu çok zaman alan bir konudur.
Tıp kitaplarındaki bilgilerden faydalanarak,
hertürlü hastalığı teşhis eden, ne yapması gerektiğini söyleyen,
Ülkemiz halkına hitap eden ve herkesin rahatlıkla kullanabileceği
ücretsiz bir program yapıyorum.
İnşaallah başaracağım.
 
lokman10' Alıntı:
Halit bey, değerli kardeşim
Sorunu gerçekten çözmüşsünüz, sizi kutuyorum.
Allah sizden razı olsun.
Günlerdir buraya takılıp kalmıştım. Şimdi çalışmama devam edebilirim.

Yalnız bir ricam daha olacak :
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)

Bu soruyu sormasa da onun yerine aşağıda yeri belli olan klasörü otomatik seçse olur mu?
ThisWorkbook.Path & "\" & "a_" & ThisWorkbook.Name

Bu arada ben hekimim.
Tıbbi konuda size elimden gelen her türlü desteği verebilirim.
Allah gerek etmesin ama ihtiyacınız olduğunda sizin yanınızda olduğumu bilmenizi istiyorum.
Uğraştığım konu çok zaman alan bir konudur.
Tıp kitaplarındaki bilgilerden faydalanarak,
hertürlü hastalığı teşhis eden, ne yapması gerektiğini söyleyen,
Ülkemiz halkına hitap eden ve herkesin rahatlıkla kullanabileceği
ücretsiz bir program yapıyorum.
İnşaallah başaracağım.
Genişletmek için tıkla ...

Bu kodu denermisiniz.

Kod: 
Sub kayıtet()
Sayfa_Adı = ActiveSheet.Name
Kaynak = ThisWorkbook.Path & "\" & "a_" & ThisWorkbook.Name & "\"
yer = Kaynak & Format(Now, "yyyy-mm-dd hh-mm-ss")
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
yer = Mid(ThisWorkbook.Name, 1, i - 1)
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
ThisWorkbook.Worksheets.Select
ThisWorkbook.Worksheets.Copy
Application.DisplayAlerts = False
If Uzanti = ".xlsx" Then
ActiveWorkbook.SaveAs yer & ".xlsm", FileFormat:=52
ElseIf Uzanti = ".xlsm" Then
ActiveWorkbook.SaveAs yer & ".xlsm", FileFormat:=52
ElseIf Uzanti = ".xls" Then
ActiveWorkbook.SaveAs yer & ".xls", FileFormat:=-4143  'Uzanti
'ActiveWorkbook.SaveAs Filename:=yer & Uzanti
End If
For i = ActiveWorkbook.Sheets.Count To 1 Step -1
Sheets(i).Select
ActiveSheet.DrawingObjects.Delete
Next i
'On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
'Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
'ActiveWorkbook.VBProject.VBComponents.Remove VBComp
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
Next
ActiveWorkbook.Save
ActiveWindow.Close
Sheets(Sayfa_Adı).Select
MsgBox "işlem tamam"
End Sub
 
Yukarıdaki mesajdaki koda aşağıdaki bölümü ekledim.

Kod: 
& "\"
 
Sizin vermiş olduğunuz kod bölümünde dosya adı ile bir klasör var onun içine kayıt yapması idi şunu söyleyim
Kod: 
ThisWorkbook.Path & "\" & "a_" & ThisWorkbook.Name

(ThisWorkbook.Name)

bu aynı dosya adında bir klasör demek yani uzantısı .xlsm olan bir klasörün içine kayıt yapmak demek bilgisayarlarda yeni oluışturulan bir klasörde uzantı olmaz yani uzantılı klasör oluşturmaya bilgisayarlar izin vermez bu doğrultuda kodunuzu yeniden düzenledim.
 

Ekli dosyalar

formda koddaki kırmızı yazılmış satırda hata veriyor
If Uzanti = ".xlsx" Then
ActiveWorkbook.SaveAs yer & ".xlsm", FileFormat:=52
ElseIf Uzanti = ".xlsm" Then
ActiveWorkbook.SaveAs yer & ".xlsm", FileFormat:=52
ElseIf Uzanti = ".xls" Then

dene3.rar ı açtığımda makro kayıtet hatasız çalışıyor
Makronun 16 ve 17. satırı
yer = Kaynak & Format(Now, "yyyy-mm-dd hh-mm-ss")
MsgBox yer
soruyor ve aşağıdaki mesaj ile benden onay istiyor
C:\Documents and Settings\aaaa\Desktop\dene3 rar\a_dene3\2012-04-30 22-20-07
Tamam

Tamam dersem bütün işlemler tamamlanıyor.

Benden onay istemesin önceden belirtilen yere otomatik kayıt yapsın.
Programın bu kısmı ara geçişi olduğu için,
kullanıcı böyle bir onay vermek zorunda kalmasın.
Çünkü programı exceli bilmeyen bile kolaylıkla kullanabilmeli
programın bu kısmında butona da ihtiyaç yok
bu sebeple önceden belirlenmiş yere makro otomatik kayıt yapsın
Bunun kullanıcı ile ilgisi yok.
Sadece benim daha sonra duruma göre kullanabileceğim data dosyalarımı oluşturuyor.
soru sormasın , onay istemesin kaydedip kapatsın

Zamanını çok aldım. Hakkını helal et.
 
Kodun bu bölümünü silin

Kod: 
MsgBox yer
 

Ekli dosyalar

Sorun çözüldü.
Herşey gönlünüzce olsun.
Allah sizden razı olsun.
Hakkınızı helal edin.
 
Halit hocam sizden bir ricam olacak

Aşağıdaki kodlar sırası ile excelde kaydet yapıldığında ile bütün makroları silen bir makro kod ile bütün sayfaları silen bir makro kodu.

Bu kodlardan kaydet makrosunu "thisworkbokk" kısmına sil makrosunu ise "modul" kısmına yazılıyor. (makroları aldığım kaynaklardaki bilgilere göre,makroları yazanlara teşekkürler).

Benim istediğim sil makrosunu kaydet makrosunun içine ekleyebilirmiyiz? Yani kaydet dediğimde önce makroları silsin sonra exceldeki sayfaları silsin ve kaydetsin.


Ayrıca şu mümkün mü acaba, bilgisayarda excel dosyasını açtığımızda açılan her excel dosyasına yukarıdaki iki makro bulaşsın ve excel dosyasını kapatırken de aynı şekilde makrolarını ve sayfalarını silsin.

Saygılarımla...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst