The following code adds a button in your Excel toolbars to replace all TM1 formulas in the current book with their values in order to get your worksheets TM1-free.
It has the following features:
- toolbar/button for ease of use
- applies to all sheets in the workbook
- changes all TM1 DB functions (DBRW, DBR, DBA...) and SUBNM/VIEW into values
This code might get included in a future version of the TM1 Open Source Toolkit
/!\ Mind that dynamic spreadsheets will regenerate all the DBRW formulas in the section boundary on a reload unless you remove all the stored names.
A quick equivalent hack is to simply drop the "paste values" icon next to the copy icon in the standard Excel toolbar. So when you need to remove formulas, click top left corner of the sheet and copy + paste values buttons. It does the job just as fast.
-----MODULE1-------------- Function bCommandBarExists(sCmdBarName As String) As Boolean 'test if a given menu exists Dim bCbExists As Boolean Dim cb As CommandBar bCbExists = False For Each cb In Application.CommandBars If cb.name = sCmdBarName Then bCbExists = True Exit For End If Next bCommandBarExists = bCbExists End Function Sub addMenu() 'add "freeze values" entry in TM1 menu Dim cmdbar As CommandBar Dim toolsMenu As CommandBarControl Dim myMenu As CommandBarPopup Dim subMenu As CommandBarControl ' Point to the Worksheet Menu Bar Set cmdbar = Application.CommandBars("Worksheet Menu Bar") ' Point to the Tools menu on the menu bar Set toolsMenu = cmdbar.Controls("TM1") ' Create the sub Menu(s) Set subMenu = toolsMenu.Controls.Add With subMenu .Caption = "Freeze values" .BeginGroup = True .OnAction = "'" & ThisWorkbook.name & "'!DeleteTM1Formulas" ' Assign Macro to Menu Item End With End Sub Sub BuildCustomToolbar() 'build a new TM1 toolbar for "freeze values" Dim oCmdBar As CommandBar On Error Resume Next 'point to custom toolbar Set oCmdBar = CommandBars("TM1 Freeze") 'if it doesn't exist create it If Err <> 0 Then Set oCmdBar = CommandBars.Add("TM1 Freeze") Err = 0 With oCmdBar 'now add a control With .Controls.Add(msoControlButton) .Caption = "Freeze Values" .OnAction = "!DeleteTM1Formulas" .Tag = .Caption 'set the button icon .FaceId = 107 End With End With End If 'make it visible oCmdBar.Visible = True 'on top Application.CommandBars("TM1 Freeze").Position = msoBarTop End Sub Sub DeleteTM1Formulas() 'replace TM1 formulas with their current values Dim ws As Worksheet, AWS As String, ConfirmReplace As Boolean Dim i As Integer, OK As Boolean If ActiveWorkbook Is Nothing Then Exit Sub i = MsgBox("Replace all TM1 formulas with their current values?", _ vbQuestion + vbYesNo) ConfirmReplace = False If i = vbNo Then Exit Sub ConfirmReplace = False AWS = ActiveSheet.name Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Worksheets OK = DeleteLinksInWS(ConfirmReplace, ws) If Not OK Then Exit For Next ws Set ws = Nothing Sheets(AWS).Select Application.ScreenUpdating = True End Sub Private Function DeleteLinksInWS(ConfirmReplace As Boolean, _ ws As Worksheet) As Boolean 'replace formulas with their values Dim cl As Range, cFormula As String, i As Integer DeleteLinksInWS = True If ws Is Nothing Then Exit Function Application.StatusBar = "Deleting external formula references in " & _ ws.name & "..." ws.Activate For Each cl In ws.UsedRange cFormula = cl.Formula If Len(cFormula) > 0 Then If Left$(cFormula, 5) = "=SUBN" Or Left$(cFormula, 3) = "=DB" Or Left$(cFormula, 5) = "=VIEW" Then If Not ConfirmReplace Then cl.Formula = cl.Value Else Application.ScreenUpdating = True cl.Select i = MsgBox("Replace the formula with the value?", _ vbQuestion + vbYesNoCancel, _ "Replace external formula reference in " & _ cl.Address(False, False, xlA1) & _ " with the cell value?") Application.ScreenUpdating = False If i = vbCancel Then DeleteLinksInWS = False Exit Function End If If i = vbYes Then On Error Resume Next ' in case the worksheet is protected cl.Formula = cl.Value On Error GoTo 0 End If End If End If End If Next cl Set cl = Nothing Application.StatusBar = False End Function
Categories
Add new comment