Sutun silinince makro çalışmaması

[cagataybaser]

Merhabalar herkese,
Özel sekmemde yarattığım(xml kullanarak) 3 adet checkbox(işaret kutusu) ve 3 adet buton var. sifirla bütün sutunların gösterilmesini,gizle ise istenilen sutunların gizlenmesini sağlıyor.Sil butonu ise sütün ismine göre sütünlari siliyor. Fakat sil butonunda silme işlemi yaptığım zaman sonrasında checkboxlarım çalışmıyor. Exceli tekrar kapatıp açmam gerekiyor. Sürekli bunu yapmamak için yardımlarınızı bekliyorum.
Saygılarımla
Xml kodlarım :

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="OnLoad">

   <ribbon startFromScratch="false">
      <tabs> <tab id="customTab" label="Ozel sekmem" keytip ="C">
      <group  id="Group1" label="Group1">
   <button id="button3" label="gizle" onAction="Gizle_Makro" />
   <button id="button1" label="sifirla" onAction="Sifirla_Makro" />
   <button id="button4" label="sil" onAction="Sil_Makro" />
      <checkBox id ="F2"    getPressed="GetPressed"  getLabel="GetLabel" onAction="KOLONAC" />
      <checkBox id ="F3"   getPressed="GetPressed" getLabel="GetLabel" onAction="KOLONAC" />
   <checkBox id= "F4" getPressed="GetPressed" getLabel="GetLabel" onAction="KOLONAC" />
            </group>
         </tab>

      </tabs>
   </ribbon>
</customUI>

Vba kodları :

Option Explicit
Dim bChk(0 To 3) As Boolean
Public objRibbon As IRibbonUI
Public Sub OnLoad(ribbon As IRibbonUI)
Dim i As Long
For i = 0 To 3
bChk(i) = True
Next i
  Set objRibbon = ribbon
  objRibbon.Invalidate
End Sub
Sub KOLONAC(control As IRibbonControl, pressed As Boolean)
    Search control.ID, pressed
End Sub
Sub Search(fnd As String, pressed As Boolean)
    Dim firstfound As String, foundcell As Range, rng As Range, myRange As Range, lastcell As Range
    Set myRange = ActiveSheet.UsedRange
    Set lastcell = myRange.Cells(myRange.Cells.Count)
    Set foundcell = myRange.Find(what:=fnd, after:=lastcell, Lookat:=xlWhole)
    If Not foundcell Is Nothing Then
        firstfound = foundcell.Address
        Do
            foundcell.EntireColumn.Hidden = Not pressed
            Set foundcell = myRange.FindNext(after:=foundcell)
        Loop While Not foundcell Is Nothing And foundcell.Address <> firstfound
    End If
End Sub

Sub sifirla_makro(control As IRibbonControl)
Dim i As Long
For i = 0 To 3
bChk(i) = True
Next i
Cells.EntireColumn.Hidden = False
objRibbon.Invalidate
End Sub
Function GetChkBox(ByVal sString) As String
Select Case sString
Case "F2"
GetChkBox = "0"
Case "F3"
GetChkBox = "1"
Case "F4"
GetChkBox = "2"
End Select
End Function


Sub Sil_makro(control As IRibbonControl)
UserForm1.Show
End Sub
Sub Gizle_Makro(control As IRibbonControl)
Dim i As Long
For i = 0 To 3
bChk(i) = False
Next i
  Sheets("Sayfa1").Columns("B:ZZ").Hidden = True
  objRibbon.Invalidate
End Sub

Sub GetLabel(control As IRibbonControl, ByRef Label)
Select Case control.ID
Case "F2"
Label = Range("B8").Value
Case "F3"
Label = Range("C8").Value
Case "F4"
Label = Range("D8").Value
End Select
End Sub
Sub GetPressed(control As IRibbonControl, ByRef Button)
Button = bChk(GetChkBox(control.ID))
End Sub


'Userform1 icinde yaratılan bir adet textbox ve button var
Private Sub CommandButton1_Click()
MSG1 = MsgBox("Silmek istediginizden emin misiniz?", vbYesNo, "Sil?")
If MSG1 = vbYes Then
Dim firstfound As String
Dim foundcell As Range, rng As Range, rng1 As Range
Dim myRange As Range, lastcell As Range
Dim fnd As String
Dim rowcell As Range

fnd = UserForm1.TextBox1.Value
Dim rngFound As Range, rngToDelete As Range
Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    
    With Sheets("Sayfa1").Range("A:A")
            Set rng = .Find(what:="BASISWERT " + UCase(fnd), _
                            after:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                    End With
                    On Error Resume Next
                
    rng.Offset(1, 0).EntireRow.Delete
    rng.Offset(0, 0).EntireRow.Delete
     
            
    
    Set myRange = ActiveSheet.UsedRange
    Set lastcell = myRange.Cells(myRange.Cells.Count)
    Set foundcell = myRange.Find(what:=fnd, after:=lastcell)
If Not foundcell Is Nothing Then
    firstfound = foundcell.Address
  End If
Set rng = foundcell
  Do Until foundcell Is Nothing
      Set foundcell = myRange.FindNext(after:=foundcell)
      Set rng = Union(rng, foundcell)
      If foundcell.Address = firstfound Then Exit Do
  Loop
  rng.EntireColumn.Delete
Else
  Exit Sub
End If
End Sub

Örnek dosya linki : ORNEK-dosya.rar indir

 

[cagataybaser]

Yokmu yardimci olabilecek..