• DİKKAT

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

Makro silen excel

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
644
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Merhabalar,
Bir excel dosyasını makronun içinde çalıştığı klasöre kopyalayıp(bu kısım manuel yapılacak) ilgili makro çalıştığında,çalışan makroyu bu excel dosyası aracılığı ile silmek mümkünmüdür.(yani excel dosyası içine böyle bir kod gömülebilirmi ? )
 
Merhabalar,
Bir excel dosyasını makronun içinde çalıştığı klasöre kopyalayıp(bu kısım manuel yapılacak) ilgili makro çalıştığında,çalışan makroyu bu excel dosyası aracılığı ile silmek mümkünmüdür.(yani excel dosyası içine böyle bir kod gömülebilirmi ? )

Çalışan makro sizin müdahale edeceğiniz bir makro değil ise mümkün değil.

Sebebi de o makro için o dosyanın orada olup olmamasının bir önemi yok.

Müdahele edebiliyorsanız o dosyaya da gerek yok. Makro çalıştığı dosyayı xlsx olarak kaydetsin. Daha sonra, var olan xlsm li dosyayı silsin.(Denemedim bir fikir)
 
Çalışan makro sizin müdahale edeceğiniz bir makro değil ise mümkün değil.

Sebebi de o makro için o dosyanın orada olup olmamasının bir önemi yok.

Müdahele edebiliyorsanız o dosyaya da gerek yok. Makro çalıştığı dosyayı xlsx olarak kaydetsin. Daha sonra, var olan xlsm li dosyayı silsin.(Denemedim bir fikir)

Merhaba,
Fikir güzel ancak söylediğim şekilde bir müdahale yapılması imkansız mı ?
 
Merhaba,
Fikir güzel ancak söylediğim şekilde bir müdahale yapılması imkansız mı ?

Eğer doğru anladıysam imkansız.

* Önceden yazılmış A.xlsm adında makrolu bir excel dosyası var.
* Bir özet tabloyu makro ile hazırlayan bir excel dosyası gibi.
* A.xlsm dosyanın bulunduğu klasöre, B.xlsm adında, makrolu excel dosyalarını normal excel dosyasına çeviren dosyayı koyuyoruz.
* A.xlsm yi çalıştırdığımız. B.xlsm yi çalıştırmasını ve A.xlsm deki makroları silmesini istiyoruz.

Sadece bir dosya kopyalayarak olmaz. Ancak kopyaladığımız dosya çalıştırılır ise o dosyayada git a.xlsm yi a.xlsx yap derseniz olur.

" ilgili makro çalıştığında,çalışan makroyu bu excel dosyası aracılığı ile silmek mümkünmüdür"
 
Eğer doğru anladıysam imkansız.

* Önceden yazılmış A.xlsm adında makrolu bir excel dosyası var.
* Bir özet tabloyu makro ile hazırlayan bir excel dosyası gibi.
* A.xlsm dosyanın bulunduğu klasöre, B.xlsm adında, makrolu excel dosyalarını normal excel dosyasına çeviren dosyayı koyuyoruz.
* A.xlsm yi çalıştırdığımız. B.xlsm yi çalıştırmasını ve A.xlsm deki makroları silmesini istiyoruz.

Sadece bir dosya kopyalayarak olmaz. Ancak kopyaladığımız dosya çalıştırılır ise o dosyayada git a.xlsm yi a.xlsx yap derseniz olur.

" ilgili makro çalıştığında,çalışan makroyu bu excel dosyası aracılığı ile silmek mümkünmüdür"


anladım.

peki şağıdaki kodu belli bir dosya ismi klasörde geçiyor ise makro ları silmesi için derleyebilirmiyiz.Mevcut hali belli bir tarih gelince sil şeklinde şuan



If Date >= #6/1/2018# Then
Set VBComps = ActiveWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, _
vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
End If

Set VBComps = Nothing
Set VBComp = Nothing
 
Bu şekilde deneyiniz.

Masaüstü yolu için aşağıdaki kodu kullanabilir siniz.
c:\users\kullanici.adi\desktop\
Kod:
     masaustu = Environ("userprofile") & "\Desktop\"

Kod:
Sub makro_sil()
 Application.DisplayAlerts = False
  'Makrolu dosya yolu
   dosya = [COLOR=red]"D:\yedek\makrolu.xlsm"[/COLOR]

  'test dosyası yolu
   testdosya =[COLOR=Red] "D:\yedek\test123.xls"[/COLOR]
   
   yenidosya = Replace(dosya, ".xlsm", ".xlsx")
   If dosyavarmi(testdosya) Then
     If dosyavarmi(dosya) Then
        Workbooks.Open Filename:=dosya, UpdateLinks:=0
        ActiveWorkbook.SaveAs Filename:=yenidosya, FileFormat:=51
        ActiveWorkbook.Close
        'Makrolu dosyayı silmek isterseniz işareti kaldırın
       [COLOR=red] 'Kill (dosya)[/COLOR]
     End If
   End If
 Application.DisplayAlerts = True
End Sub

Function dosyavarmi(dosya)
  Dim ds, a
  Set ds = CreateObject("Scripting.FileSystemObject")
  a = ds.FileExists(dosya)
  If a = True Then
    dosyavarmi = True
  Else
    dosyavarmi = False
  End If
End Function
 
Son düzenleme:
dosya ismi

Merhaba ,
excel dosya adını(bakılacak dosya örneğin ismi "test123.xls" nereye yazacağız
 
Bakılacak dosya nedir bilemiyorum. Ancak makrosu silinecek dosya kod içinde kırmızı yazılı yer.

Merhaba,
Bakılacak dosya masaüstünde "deneme"klasörünün içinde "test123.xls"dosyası olacak yani deneme klasörünün içinde"test123.xls"dosyası var ise "deneme" klasörünün içindeki "makro.xlm"dosyasındaki makrolar silinecek
 
Merhaba,
Bakılacak dosya masaüstünde "deneme"klasörünün içinde "test123.xls"dosyası olacak yani deneme klasörünün içinde"test123.xls"dosyası var ise "deneme" klasörünün içindeki "makro.xlm"dosyasındaki makrolar silinecek


Kod güncellendi. Kontrol ediniz.
 
kod

Merhaba kodu bu şekilde çalışmıyor nerede hata yapıyorum acaba



Application.DisplayAlerts = False
'Makrolu dosya yolu
dosya = "C:\Users\aaa\Desktop\format\dosya.xlsm"

'test dosyası yolu
testdosya = "C:\Users\aaa\Desktop\format\test123.xlsx"

yenidosya = Replace(dosya, ".xlsm", ".xlsx")
If dosyavarmi(testdosya) Then
If dosyavarmi(dosya) Then
Workbooks.Open Filename:=dosya, UpdateLinks:=0
ActiveWorkbook.SaveAs Filename:=yenidosya, FileFormat:=51
ActiveWorkbook.Close
'Makrolu dosyayı silmek isterseniz işareti kaldırın
Kill (dosya)
End If
End If
Application.DisplayAlerts = True
End Sub

Function dosyavarmi(dosya)
Dim ds, a
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(dosya)
If a = True Then
dosyavarmi = True
Else
dosyavarmi = False
End If
End Function







Bu şekilde deneyiniz.

Masaüstü yolu için aşağıdaki kodu kullanabilir siniz.
c:\users\kullanici.adi\desktop\
Kod:
     masaustu = Environ("userprofile") & "\Desktop\"

Kod:
Sub makro_sil()
 Application.DisplayAlerts = False
  'Makrolu dosya yolu
   dosya = [COLOR=red]"D:\yedek\makrolu.xlsm"[/COLOR]

  'test dosyası yolu
   testdosya =[COLOR=Red] "D:\yedek\test123.xls"[/COLOR]
   
   yenidosya = Replace(dosya, ".xlsm", ".xlsx")
   If dosyavarmi(testdosya) Then
     If dosyavarmi(dosya) Then
        Workbooks.Open Filename:=dosya, UpdateLinks:=0
        ActiveWorkbook.SaveAs Filename:=yenidosya, FileFormat:=51
        ActiveWorkbook.Close
        'Makrolu dosyayı silmek isterseniz işareti kaldırın
       [COLOR=red] 'Kill (dosya)[/COLOR]
     End If
   End If
 Application.DisplayAlerts = True
End Sub

Function dosyavarmi(dosya)
  Dim ds, a
  Set ds = CreateObject("Scripting.FileSystemObject")
  a = ds.FileExists(dosya)
  If a = True Then
    dosyavarmi = True
  Else
    dosyavarmi = False
  End If
End Function
 
güncel

Merhabalar,
konu günceldir hala
 
Geri
Üst