Forum

Select and align al...
 
Notifications
Clear all

Select and align all slicers on sheet

3 Posts
2 Users
0 Reactions
231 Views
(@swallack202)
Posts: 77
Estimable Member
Topic starter
 

Hi -

I'm trying to size, align, and vertically stack all the slicers on a sheet.

I tried two approaches. First, I have code to loop thru the slicers, select them one by one, and then position them. I think the problem is that it's not adding slicers to the selection, but replacing one selection with the next. I'm also not sure it's actually moving anything at all!

Second I tried an array. That seems less prone to error than selecting objects. But I can't figure out how to add only the slicers to the array.

See attached sample XLS.

Thanks!

 
Posted : 09/06/2022 6:18 pm
(@debaser)
Posts: 838
Member Moderator
 

You could use something like this:

Sub Main()

Dim ws As Worksheet
Set ws = ActiveSheet

Call AlignSlicersVertical(ws)

End Sub

Sub AlignSlicersVertical(ByVal ws As Worksheet)

' Declare variable names and type for this procedure
Dim iNumShapes As Integer

iNumShapes = ws.DrawingObjects.Count
Dim shapeNames() As String
ReDim shapeNames(1 To iNumShapes)
Debug.Print "Shapes detected: " & iNumShapes

If iNumShapes = 0 Then Exit Sub

' Declare variable names and type for this procedure
Dim shp As Shape
Dim iNumSlicers As Integer
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dHeight As Double
Const dSPACE As Double = 8

With ws
For Each shp In ws.Shapes
If shp.Type = msoSlicer Then
iNumSlicers = iNumSlicers + 1
shapeNames(iNumSlicers) = shp.Name
End If
Next shp
Debug.Print "Slicers detected and selected: " & iNumSlicers
End With

If iNumSlicers > 0 Then
ReDim Preserve shapeNames(1 To iNumSlicers)
lCnt = 1

For Each shp In ws.Shapes.Range(shapeNames)
With shp
Debug.Print "Positioning Slicers: " & shp.Name
If lCnt > 1 Then
.Top = dTop + dHeight + dSPACE
.Left = dLeft
End If

dTop = .Top
dLeft = .Left
dHeight = .Height
End With

lCnt = lCnt + 1
Next shp
End If

End Sub

 
Posted : 10/06/2022 3:54 am
(@swallack202)
Posts: 77
Estimable Member
Topic starter
 

Thank you. I will review your approach above. Meanwhile, before reading your response, I ended up with what you see below. The problem is in red, where I try to move the slicers.

Sub Main()

Call AlignSlicersVertical(ActiveSheet.Index)

End Sub

Sub AlignSlicersVertical(ByVal SheetIndexNumber As Long)
DebugPrint "---"
DebugPrint "AlignSlicersVertical(" & SheetIndexNumber & ")"

' Code to exit if sheet is locked removed from here for forum

' Exit if there are no shapes
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets(SheetIndexNumber)
Dim iNumShapes As Integer
iNumShapes = ws.Shapes.Count
If iNumShapes = 0 Then Set ws = Nothing: Exit Sub

' Add slicers to a collection
Dim iNumSlicers As Integer
Dim shp As Shape
Dim colShapes As New Collection

With ws
  For Each shp In ws.Shapes
    If shp.Type = msoSlicer Then
      iNumSlicers = iNumSlicers + 1 ' Count slicers
      colShapes.Add shp ' Add slicers to collection
      ' Unlock the shape so it can be manipulated below
      colShapes.Item(iNumSlicers).locked = False ' Unlock
      DebugPrint "Proof shape is unlocked..... Slicer " & colShapes.Item(iNumSlicers).Name & " | Locked = " & colShapes.Item(iNumSlicers).locked
    End If
  Next shp
End With

' Position and size slicers in the collection
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dHeight As Double
Dim dWidth As Double
Dim chObj As ChartObject

Const dSPACE As Double = 2

dTop = Int(ws.ChartObjects(1).Top)
dLeft = Int(ws.ChartObjects(1).Left + ws.ChartObjects(1).Width + (3 * dSPACE))
dHeight = Int(ws.ChartObjects(1).Height / (iNumSlicers - 1)) ' Subtract 1 to ignore the "VALID" slcer, which we will hide
dWidth = Int(Application.InchesToPoints(2.7))

For lCnt = 1 To iNumSlicers
  ' All slicers share these properties
  DebugPrint "Checkng Locked status again... Slicer (" & lCnt & " of " & iNumSlicers & "): " & colShapes.Item(lCnt).Name & " | Locked = " & colShapes.Item(lCnt).locked
  colShapes.Item(lCnt).Height = dHeight ' THIS THROWS AN ERROR - SHAPE IS LOCKED?
  colShapes.Item(lCnt).Width = dWidth
  colShapes.Item(lCnt).Left = dLeft

  If lCnt = 1 Then ' Position the first slcer at the top
    colShapes.Item(lCnt).Top = dTop

  ElseIf InStrRev(colShapes.Item(lCnt).Name, "VALID") Then ' Hide the VALID slicer
    colShapes.Item(lCnt).Top = dTop + dSPACE
    colShapes.Item(lCnt).Left = dLeft + dSPACE
    colShapes.Item(lCnt).Height = dHeight - (2 * dSPACE)
    colShapes.Item(lCnt).Width = dWidth - (2 * dSPACE)
    colShapes(lCnt).Visible = msoFalse
    colShapes(lCnt).ZOrder msoSendToBack

  Else ' Position other slicers in a stack
    colShapes.Item(lCnt).Top = colShapes.Item(lCnt - 1).Top + dHeight + dSPACE
    colShapes.Item(lCnt).Left = dLeft
    colShapes.Item(lCnt).Height = dHeight
    colShapes.Item(lCnt).Width = dWidth
  End If

Next lCnt

DoEvents

Set ws = Nothing

End Sub
 
Posted : 10/06/2022 1:00 pm
Share: