Userform ve Module Silme Hakkında

petsiye

Altın Üye
Katılım
28 Eylül 2009
Mesajlar
171
Excel Vers. ve Dili
Office 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
10-05-2029
Merhaba,

Rapor oluşturmak amacıyla hazırladığım İkili çalışma kitabı dosyasında, istediğim rapor oluşturulduktan sonra aşağıdaki Userform ve Modul'lerin aynı anda silinmesini ve dosyanın kaydedilmesini VBA kod ile nasıl sağlayabilirim.

Kısacası aşağıdaki Userformları ve Modulleri VBA ile silmek istiyorum.

Yardımcı olabilecek kişilere çok teşekkür ederim

Saygılarımla



Userform9
Userform24
Userform17
Userform21

Module227
Module4
Module244
Module9
Module23
Module13
Module14
Module7
Module24
Module45
Module5
Module88
 

petsiye

Altın Üye
Katılım
28 Eylül 2009
Mesajlar
171
Excel Vers. ve Dili
Office 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
10-05-2029
Merhaba Korhan Bey,
Evet soruyu sormadan önce bu yorumu görüp denemiştim fakat sonuç alamamıştım. Benimkisi biraz daha basit bir talep fakat bir türlü beceremedim maalesef
Saygılarımla
 
Katılım
11 Temmuz 2024
Mesajlar
191
Excel Vers. ve Dili
Excel 2021 Türkçe
Merhaba, şu şekilde deneyip sonucu paylaşabilir misiniz;

Kod:
Sub DeleteSpecifiedComponents()
    Dim vbComp As VBComponent
    Dim compName As String
    Dim itemsToDelete As Variant
    Dim i As Long
    itemsToDelete = Array("Userform9", "Userform24", "Userform17", "Userform21", _
                          "Module227", "Module4", "Module244", "Module9", "Module23", _
                          "Module13", "Module14", "Module7", "Module24", "Module45", _
                          "Module5", "Module88")
    On Error Resume Next
    For i = LBound(itemsToDelete) To UBound(itemsToDelete)
        compName = itemsToDelete(i)
        Set vbComp = ThisWorkbook.VBProject.VBComponents(compName)
        If Not vbComp Is Nothing Then
            ThisWorkbook.VBProject.VBComponents.Remove vbComp
        End If
    Next i
    On Error GoTo 0
    ThisWorkbook.Save
End Sub
Lütfen işlemden önce yedek almayı unutmayın.
 

petsiye

Altın Üye
Katılım
28 Eylül 2009
Mesajlar
171
Excel Vers. ve Dili
Office 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
10-05-2029
Sayın @pitchoute, Verdiğiniz kodu denedim. Tekil çalıştırdığımda sorun yok görevini yapıyor. Fakat, biraz revize edip rapor dosyasının sonuna aşağıdaki gibi kod olarak eklediğimde görevini yapmıyor. nedenini ben de anlamadım.


Sub FARKLIKAYDETTEST()
'
' FARKLIKAYDETTEST Makro
'
On Error Resume Next
Application.ScreenUpdating = False
On Error Resume Next
On Error Resume Next
Call KOPRU
On Error Resume Next
Application.ScreenUpdating = True
On Error Resume Next
Call KOKPIT
Call FILTRESAYFASITEMIZLE
Application.ScreenUpdating = True
On Error Resume Next
Call FILTREKOPRU
On Error Resume Next
Application.ScreenUpdating = True
On Error Resume Next
Application.ScreenUpdating = False
On Error Resume Next
Dim DosyaAdi As String
DosyaAdi = Format(Date, "dd mmmm yyyy dddd") & " " & " - TEST " & ".xlsb"
ThisWorkbook.SaveAs Filename:="C:\Users\Monster\Desktop\PROJE TEST\" & DosyaAdi, FileFormat:=xlExcel12


Dim vbComp As VBComponent
Dim compName As String
Dim itemsToDelete As Variant
Dim i As Long
itemsToDelete = Array("Userform9", _
"Module227", "Module4", "Module244", "Module9", "Module23", _
"Module13", "Module14", "Module7", "Module24", "Module45", _
"Module5", "Module88")
On Error Resume Next
For i = LBound(itemsToDelete) To UBound(itemsToDelete)
compName = itemsToDelete(i)
Set vbComp = ThisWorkbook.VBProject.VBComponents(compName)
If Not vbComp Is Nothing Then
ThisWorkbook.VBProject.VBComponents.Remove vbComp
End If
Next i
On Error GoTo 0
ThisWorkbook.Save
On Error Resume Next
ThisWorkbook.Save
On Error Resume Next
ActiveWorkbook.Save
End

'
End Sub
 
Katılım
11 Temmuz 2024
Mesajlar
191
Excel Vers. ve Dili
Excel 2021 Türkçe
Merhaba, şu şekilde dener misiniz;

Kod:
Sub FARKLIKAYDETTEST()
    On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    Call KOPRU
    Application.ScreenUpdating = True
    Call KOKPIT
    Call FILTRESAYFASITEMIZLE
    Application.ScreenUpdating = True
    Call FILTREKOPRU
    Application.ScreenUpdating = False
    Dim DosyaAdi As String
    DosyaAdi = Format(Date, "dd mmmm yyyy dddd") & " " & " - TEST " & ".xlsb"
    ThisWorkbook.SaveAs Filename:="C:\Users\Monster\Desktop\PROJE TEST\" & DosyaAdi, FileFormat:=xlExcel12
    Call DeleteSpecifiedComponents
    ThisWorkbook.Save
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "Bir hata oluştu: " & Err.Description, vbCritical
End Sub

Sub DeleteSpecifiedComponents()
    Dim vbComp As VBComponent
    Dim compName As String
    Dim itemsToDelete As Variant
    Dim i As Long
    itemsToDelete = Array("Userform9", "Userform24", "Userform17", "Userform21", _
                          "Module227", "Module4", "Module244", "Module9", "Module23", _
                          "Module13", "Module14", "Module7", "Module24", "Module45", _
                          "Module5", "Module88")
    On Error Resume Next
    For i = LBound(itemsToDelete) To UBound(itemsToDelete)
        compName = itemsToDelete(i)
        Set vbComp = ThisWorkbook.VBProject.VBComponents(compName)
        If Not vbComp Is Nothing Then
            If vbComp.Name <> Me.Name Then
                ThisWorkbook.VBProject.VBComponents.Remove vbComp
            End If
        End If
    Next i
    On Error GoTo 0
End Sub
 

petsiye

Altın Üye
Katılım
28 Eylül 2009
Mesajlar
171
Excel Vers. ve Dili
Office 2019 TR 32 Bit
Altın Üyelik Bitiş Tarihi
10-05-2029
Aldığım hata bu şekilde Sayın @pitchoute

254428
 
Üst