Farklı Kaydet yaptığımızda yeni dosyada modül veya makroların silinmesi

[mithrill74]

Öncelikle bu forumda emeği geçen herkese teşekkür etmek istiyorum.

Benim sorunum bir dosyayı farklı kaydettiğimizde yeni dosyadaki tüm modüllerin veya makroların silinmesi ve bunun yanısıra workbookopen deki bilgilerin de silinmesi.

Bunu ayrı bir kodla nasıl yapabiliriz acaba?

Herkese iyi çalışmalar.))

 

[mithrill74]

yardım lütfen

ya bu konuda yardımcı olabilecek kimse yok mu?
hepsini tek tek silmek zozrunda kalıyorum.

 

[veyselemre]

http://www.excel.web.tr/showthread.php?t=29745

 

[mithrill74]

Olmuyor

Sayin Veyselemre Öncelİkle İlgİnİz İÇİn TeŞekkÜr Ederİm.
Fakat Kodlari Denedİm Ama ÇaliŞtiramadim
GÖzÜmden KaÇan BİrŞeymİ Var Acaba

 

[veyselemre]

Aşağıdaki kodları ThisWorkbook kod kısmına koyun. Sadece farklı kaydette çalışacaktır.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ThisWorkbook.Path <> "" And SaveAsUI Then
        Set VBComps = ActiveWorkbook.VBProject.VBComponents
        For Each VBComp In VBComps
            Select Case VBComp.Type
                Case 100
                    With VBComp.CodeModule
                        .DeleteLines 1, .CountOfLines
                    End With
                Case Else
                    VBComps.Remove VBComp
            End Select
        Next VBComp
        Set VBComps = Nothing
    End If
End Sub

 

[mithrill74]

olmadı

sayın veyselemre ilginiz için tekrar teşekkür etmek istiyorum fakat kodları çalıştıramadım.

 

[veyselemre]

Örneği inceleyin.

 

[Korhan Ayhan]

Selamlar,

Sn. veyselemre beyin size sunmuş olduğu çözümü ekli dosyada bulabilirsiniz. Dosyaya denemeniz için üç adet modül ekledim. Dosyayı indirdikten sonra açıp farklı kaydet yapıp dosyayı farklı bir isimle kaydettiğinizde kodların silindiğini görebilirsiniz.

Kodların çalışması için ARAÇLAR-MAKRO-GÜVENLİK menüsünden GÜVENİLEN YAYIMCILAR sekmesinden Visual Basic Project Erişimine Güven seçeneğini işaretleyip tamam deyin.

 

[mithrill74]

farklı kaydette makroların silinmesi

sayın costcontrol ve veyselemre.
öncelikle ilginiz için teşekkür ederim. deiğiniz gibi ARAÇLAR-MAKRO-GÜVENLİK menüsünden GÜVENİLEN YAYIMCILAR sekmesinden Visual Basic Project Erişimine Güven seçeneğini işaretleyip tamam dediğimizde vermiş olduğunuz örnekler gayet güzel çalışıyor.
fakat;

Sub farklıkaydet()

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

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

If vFilename = False Then Exit Sub

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

ile farklı kaydet yaptığımızda kodlar çalışmıyor. bunun sebebi nedir acaba?

 

[mithrill74]

bu konuda herhangi bir fikri olan yok mu acaba?

 

[Korhan Ayhan]

Selamlar,

Bu durumda kodlarınızı aşağıdaki gibi değiştirmeniz gerekecektir.

Sub farklıkaydet()
    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)
    Set VBComps = ActiveWorkbook.VBProject.VBComponents
    For Each VBComp In VBComps
    Select Case VBComp.Type
    Case 100
    With VBComp.CodeModule
    .DeleteLines 1, .CountOfLines
    End With
    Case Else
    VBComps.Remove VBComp
    End Select
    Next VBComp
    Set VBComps = Nothing
End Sub

 

[mithrill74]

yine olmadı .((

 

[Korhan Ayhan]

Selamlar,

Deneyerek kodları eklemiştim. Bende kodlar gayet güzel çalıştı. Sizde olmayan nedir açıklarmısınız.

 

[mithrill74]

farklı kaydeti userform üzerindeki bir buton aracılığıyla yapıyorum
kodları değiştirdikten sonra modüller ve userformlar yine silinmiyor.
acaba atladığım bişeymi var ki

 

[Korhan Ayhan]

Selamlar,

Size önerdiğimiz kodu boş bir excel sayfasına userform ve modüller ekleyerek denedim. Hatta dosyanın birçok yerine makrolar ekleyerek test ettiğimde farklı kaydet yaptığım dosyadaki tüm modül ve formları sildiğini gözlemledim. Bence siz uygularken bir yerlerde hata yapıyorsunuz.

Örnek dosyanızı eklerseniz yardımcı olmaya çalışırız.

 

[hsayar]

Selamlar,

Bu durumda kodlarınızı aşağıdaki gibi değiştirmeniz gerekecektir.

Sub farklıkaydet()
    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)
    Set VBComps = ActiveWorkbook.VBProject.VBComponents
    For Each VBComp In VBComps
    Select Case VBComp.Type
    Case 100
    With VBComp.CodeModule
    .DeleteLines 1, .CountOfLines
    End With
    Case Else
    VBComps.Remove VBComp
    End Select
    Next VBComp
    Set VBComps = Nothing
End Sub

sn hocam benim kodlrımda durum ne olmalı ben dosyanın adını değişken ile veriyorum ancak bana tekrar dosya adı soruyor,
Tam olarak istediğim a1 hücresindeki tarihin (01/11/2007) mmyyyy formatı ile (112007) farklı kaydedilen çalışma kitabından Sayfa1,sayfa2,sayfa3,sayfa4 adlı çalışma sayfalarını ve Tüm makro varsa form vs. silmesi.

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
        [color=Red]farklıkaydet[/color][color=blue]  denedim, ama tekrar dosya adı sordu[/color]
'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[code]

makro silme konusu ile alakalı değil ama birbirine bağlı 'Aynı dosyaya dön dendiğinde de Sayfa1,sayfa2,sayfa3,sayfa4 haricindeki çalışma sayfalarını silen kodları verirseniz mükemmel olur.

Saygılarımla

 

[hsayar]

Ayrıca

..........
[color=red]    Set VBComps = ActiveWorkbook.VBProject.VBComponents
[/color]

satırında
visialbasic projesine programlı olarak erişim güvenli değil hata mesajı dönüyor.

Tekrar saygılar sunarım

 

[Ferhat Pazarçevirdi]

Ayrıca

..........
[COLOR=red]   Set VBComps = ActiveWorkbook.VBProject.VBComponents[/COLOR]

satırında
visialbasic projesine programlı olarak erişim güvenli değil hata mesajı dönüyor.

Tekrar saygılar sunarım

Menüden, Araçlar->Seçenekler->Güvenlik Sekmesini seçin.

"Makro Güvenliği" butonuna tıklayın.

"Güvenilen Yayımcılar" sekmesini seçin.

"Visual Basi Project erişimine güven" kutucuğunu işaretleyin.

Makroyu yeniden çalıştırın.

 

[hsayar]

Ben Sayfadaki Sayfa1 deki a1 hücresindeki değer ile kaydetmek istiyorum nasıl olacak?

Menüden, Araçlar->Seçenekler->Güvenlik Sekmesini seçin.

"Makro Güvenliği" butonuna tıklayın.

"Güvenilen Yayımcılar" sekmesini seçin.

"Visual Basi Project erişimine güven" kutucuğunu işaretleyin.

Makroyu yeniden çalıştırın.

sayın fpc ilginize teşekkür ederim.

Bir sorum daha olacak ben çalışma kitabı başka bir makro ile a1 gücresindeki değer ile farklı kaydediyorum prosodörü vba larrı temizleyen farklı kaydet işelmine yollayınca benden dosya adı istiyor. Kodlarımı nasıl revize etmeliyim?

Yada mevcut farklı kaydet prosodürüne Sayfa1 deki a1 hücresindeki değer ile kaydet nasıl denir?


Tam olarak istediğim a1 hücresindeki tarihin (01/11/2007) mmyyyy formatı ile (112007) farklı kaydedilen çalışma kitabından Sayfa1,sayfa2,sayfa3,sayfa4 adlı çalışma sayfalarını ve Tüm makro varsa form vs. silmesi.

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
        [color=Red]farklıkaydet[/color][color=blue]  denedim, ama tekrar dosya adı sordu[/color]
'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

makro silme konusu ile alakalı değil ama birbirine bağlı 'Aynı dosyaya dön dendiğinde de Sayfa1,sayfa2,sayfa3,sayfa4 haricindeki çalışma sayfalarını silen kodları verirseniz mükemmel olur.

Saygılarımla

 

[hsayar]

yardımlarınız için şimdiden teşekkür ederim