Ångra-rutin i VBA


I detta tips demonstreras hur vi kan skapa ångra-rutiner för egna procedurer, vilka kan nås via de vanliga ångra-kommandona i Excel.

I exemplet infogas för varje cells formel en felhanteringsrutin, där vi använder oss av funktionerna OM och ÄRFEL.

Om vi har formler liknande =A1/B1 och exekverar nedanstående kod blir resultatet: =OM(ÄRFEL(A1/B1 );"";A1/B1).

Namnet för ångra-kommandot heter i exemplet "Ångra formelverifiering".

 

Om ett felmeddelande erhålls vid kopiering till VBA-modul så läs mer här»
 

 

(© 2002 - 2004 All rights Colo - Used by permission)

Option Explicit

Option Private Module

 

'Egendefinierad datatyp

Private Type RestRange

   Formul As Variant 'Lagrar formler

   Addr As String 'Lagrar celladresser

End Type

 

Dim wbOld As Workbook

Dim wsOld As Worksheet

Dim rnOld() As RestRange 'Array för att läsa in flera cellers formler o adresser

Dim i As Long

 

Sub VerifieringSaknas()

   '© 2004 Alla rättigheter XL-Dennis

   Dim rnCell As Range

   Dim stOldFormula As String, stNewFormula As String

   Dim stMsg As String

 

   stMsg = "En eller flera celler i markeringen innehåller ingen formel." & vbCrLf _

         & "V v ange ett nytt område."

 

 

   Application.ScreenUpdating = False

 

   'Dimensionering av arrayen utifrån antal celler i markerat cellområde.

   ReDim rnOld(Selection.Count)

   Set wbOld = ActiveWorkbook

   Set wsOld = ActiveSheet

 

   'Loopar igenom cellområdet med formler och

   '1) Skriver celladresser och deras formelvärden till arrayen.

   '2) Skapar och infogar de nya formlerna.

   i = 0

   For Each rnCell In Selection

      i = i + 1

      With rnCell

         rnOld(i).Addr = .Address

         rnOld(i).Formul = .Formula

         If .HasFormula = True Then

            stOldFormula = Right(.Formula, Len(.Formula) - 1)

            stNewFormula = "=IF(ISERROR(" & stOldFormula & " ),""""," & stOldFormula & ")"

            .Formula = stNewFormula

         Else

            MsgBox stMsg, vbCritical, "Verifiering av formel"

            Exit Sub

         End If

      End With

   Next rnCell

 

   With Application

      .OnUndo "Ångra formelverifiering", "UndoFormula" 'Här initieras Ångra-funktionen.

      .ScreenUpdating = True

   End With  

End Sub


 'Ångra-funktionen

Sub UndoFormula()

   Application.ScreenUpdating = False

 

   'Aktiverar den aktuella arbetsboken och arbetsbladet.

   wbOld.Activate

   wsOld.Activate

 

   'Skriver tillbaka de gamla formlerna i cellområdet.

   For i = 1 To UBound(rnOld)

      Range(rnOld(i).Addr).Formula = rnOld(i).Formul

   Next i

 

   Application.ScreenUpdating = True

End Sub