cancel
Showing results for 
Search instead for 
Did you mean: 

VBA script to group/degroup columns and rows

Former Member
0 Kudos

Hello,

i'm using VBA script to Group/Degroup columns/rows in a protected report. i have two scripts :

- The first one which is based on Excel protecting functions

- The second one which which is based on EPM protecting functions

The final result is the same, the script are both working, but i notice that the second one is longer than the first one.

Did someone already use these kind of VBA script and what could be the good practices ?

You will find the two script enclosed.

Thanks for your help.


Edouard

Accepted Solutions (0)

Answers (1)

Answers (1)

former_member186338
Active Contributor
0 Kudos

Hi Edouard,

I don't see any protection code in the attached file! Only selective refresh.

EPM protection is the same as Excel protection with the only difference - the password is stored in the hidden object in the workbook - for EPM to be able to refresh protected sheet.

Vadim

Former Member
0 Kudos

Hi,

As you know, i'm not an expert in VBA code but
in the file enclosed, there is :

ActiveSheet.unprotect ("rw")

rw is the password.

Edouard

former_member186338
Active Contributor
0 Kudos

There is no line with ActiveSheet.unprotect ("rw") in the attached file. Please, post code without attachment - directly in the message.

P.S. Copy of the attached file:

Sub REFRESH2()

Application.ScreenUpdating = False

Application.EnableEvents = False

Application.DisplayAlerts = False

'Timer

  Dim T As Double

  Dim Cellule As Range, Plage As Range, Cell As Range

  T = Timer

   Dim api As Object

   Set api = Application.COMAddIns("FPMXLClient.Connect").Object

  

   Dim SCENARIO_GRP As String

   SCENARIO_GRP = Range("G29")

  

   Dim SCENARIO_CTXT As String

   SCENARIO_CTXT = Range("G32")

  

If SCENARIO_CTXT = "RM" Or _

     SCENARIO_CTXT = "BS" Or _

     SCENARIO_GRP = "ACTU" Then

     Sheets("A").Select

     api.RefreshActiveSheet

     Sheets("ACCUEIL").Select

  

   ElseIf SCENARIO_GRP = "T_PMT" Then

   Sheets("A").Select

   api.RefreshActiveSheet

   Sheets("B").Select

   api.RefreshActiveSheet

   Sheets("C").Select

   api.RefreshActiveSheet

   Sheets("D").Select

   api.RefreshActiveSheet

   Sheets("E").Select

   api.RefreshActiveSheet

   Sheets("ACCUEIL").Select

  

   Else: SCENARIO_CTXT = "BN"

   api.RefreshActiveWorkBook

  

   End If

  

  

    MsgBox ("Le temps du SaveAndRefresh est de : " & Format(Round(Timer - T), "00.00" & " Sec"))

    

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.DisplayAlerts = True

End Sub

Former Member
0 Kudos

SCRIPT 1 : Sub Collapse_All()     ActiveSheet.Unprotect ("rw")     ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1     ActiveSheet.Protect ("rw") End Sub Sub Expand_All()     ActiveSheet.Unprotect ("rw")     ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8     ActiveSheet.Protect ("rw") End Sub SCRIPT 2 : Sub Expand_All() Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False       Dim api As Object     Set api = Application.COMAddIns("FPMXLClient.Connect").Object     api.SetSheetOption ActiveSheet, 301, False, "rw"     ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8     api.SetSheetOption "M003", 301, True, "rw" Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True End Sub Sub Collapse_All() Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False       Dim api As Object     Set api = Application.COMAddIns("FPMXLClient.Connect").Object     api.SetSheetOption ActiveSheet, 301, False, "rw"     ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1     api.SetSheetOption "M003", 301, True, "rw" Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True End Sub

former_member186338
Active Contributor
0 Kudos

If you initially protected sheet using EPM protection with very secret password "rw" then this password is stored in the hidden object. And you can use Excel protection API:

ActiveSheet.Unprotect ("rw")
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
ActiveSheet.Protect ("rw")

If you don't change the password EPM will still correctly work.

Vadim

Former Member
0 Kudos

ok Vadim,

thanks for your help !