Macro update for VBA PPT to fit contents of a slide to a specific predefined workarea

NOTE: code below serves as an example, as it cannot be tested given the information in your post. Please adapt it to your situation as needed.

I've included several (hopefully) helpful additions to your code in order to improve readability and maintainability. These include:

1. Error Checking - make sure the user has provided all the values required for the macro to effectively execute, and...
2. ... declare your variables as close as possible to their first use.

Note the use of targetSlides as the focus object for all the selected slides. This way you avoid to continually reference ActivePresentation.Slides(1). (Note this was an assumption on my part, adjust the code as necessary)

    '--- make sure the user has selected at least two slides
    Dim targetSlides As SlideRange
    If ActiveWindow.Selection.Type = ppSelectionSlides Then
        Set targetSlides = ActiveWindow.Selection.SlideRange
    Else
        MsgBox "Please select two or more slides in the left-hand slide overview panel.", _
               vbCritical + vbInformation + vbOKOnly, "Select Slides for Grids"
        Exit Sub
    End If
    
    '--- make sure the grid values are set
    If targetSlides(1).Tags("Grid Height") = vbNullString Then
        MsgBox "Please set grid size in Prezent Admin > Settings", _
               vbCritical + vbInformation + vbOKOnly, "Set Grid Size"
        End
    End If
    
    '--- assumes ONLY the first slide in the target slides has the Grid tags
    Dim gridTop As Long
    Dim gridLeft As Long
    Dim gridHeight As Long
    Dim gridWidth As Long
    Dim fontSize As Double
    With targetSlides(1)
        gridTop = .Tags("GRID TOP")
        gridLeft = .Tags("GRID LEFT")
        gridHeight = .Tags("GRID HEIGHT")
        gridWidth = .Tags("GRID WIDTH")
        fontSize = IIf(.Tags("FONT SIZE") <> vbNullString, .Tags("FONT SIZE"), 0#)
    End With

3. Break code into separate subs or functions to increase the readability of the logic.

It's easy to get lose the overall point of the solution when you have to mentally summarize large blocks of code. In my example, the main logic loop is:

    Dim sld As Slide
    For Each sld In targetSlides
        ResetTextSize fontSize, sld
        
        Dim slideShapes As ShapeRange
        Set slideShapes = SelectAllShapes(sld)
        
        CreateShapeGrid sld, slideShapes, _
                        gridTop, gridLeft, gridHeight, gridWidth
    Next

Before looking at the full solution below, look at some of the supporting subs and functions. Most especially, note the function IsPlaceholder which checks a Shape on any slide to see if it's part of the layout (and shouldn't be selected) or not.

Full code module:

Option Explicit

Sub FitContents()
    '--- make sure the user has selected at least two slides
    Dim targetSlides As SlideRange
    If ActiveWindow.Selection.Type = ppSelectionSlides Then
        Set targetSlides = ActiveWindow.Selection.SlideRange
    Else
        MsgBox "Please select two or more slides in the left-hand slide overview panel.", _
               vbCritical + vbInformation + vbOKOnly, "Select Slides for Grids"
        Exit Sub
    End If
    
    '--- make sure the grid values are set
    If targetSlides(1).Tags("Grid Height") = vbNullString Then
        MsgBox "Please set grid size in Prezent Admin > Settings", _
               vbCritical + vbInformation + vbOKOnly, "Set Grid Size"
        End
    End If
    
    '--- assumes ONLY the first slide in the target slides has the Grid tags
    Dim gridTop As Long
    Dim gridLeft As Long
    Dim gridHeight As Long
    Dim gridWidth As Long
    Dim fontSize As Double
    With targetSlides(1)
        gridTop = .Tags("GRID TOP")
        gridLeft = .Tags("GRID LEFT")
        gridHeight = .Tags("GRID HEIGHT")
        gridWidth = .Tags("GRID WIDTH")
        fontSize = IIf(.Tags("FONT SIZE") <> vbNullString, .Tags("FONT SIZE"), 0#)
    End With
    
    Dim sld As Slide
    For Each sld In targetSlides
        ResetTextSize fontSize, sld
        
        Dim slideShapes As ShapeRange
        Set slideShapes = SelectAllShapes(sld)
        
        CreateShapeGrid sld, slideShapes, _
                        gridTop, gridLeft, gridHeight, gridWidth
    Next
End Sub

Sub ResetTextSize(ByVal fontSize As Double, ByRef sld As Slide)
    '--- (re)set the font sizes in all shapes with text, as long
    '    as it's not a placeholder shape on the current slide
    If fontSize > 0 Then
        Dim shp As Shape
        For Each shp In sld.Shapes
            If Not IsPlaceholder(sld, shp) Then
                If shp.HasTextFrame Then
                    If shp.TextFrame.HasText Then
                        shp.TextFrame.TextRange.Font.Size = fontSize
                    End If
                End If
            End If
        Next
    End If
End Sub

Function IsPlaceholder(ByRef sld As Slide, ByRef shp As Shape) As Boolean
    With sld.Shapes.Placeholders
        IsPlaceholder = False
        If .Count > 0 Then
            Dim i As Long
            For i = 1 To .Count
                If .Item(i).Name = shp.Name Then
                    IsPlaceholder = True
                    Exit Function
                End If
            Next i
        End If
    End With
End Function

Function CollectionToArray(ByRef c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim i As Integer
    For i = 1 To c.Count
        a(i - 1) = c.Item(i)
    Next
    CollectionToArray = a
End Function

Function SelectAllShapes(ByRef sld As Slide) As ShapeRange
    '--- creates a Collection of all the non-placeholder shape names, then
    '    convert the names to an array to create a ShapeRange object
    Dim shp As Shape
    Dim shps As Collection
    Set shps = New Collection
    For Each shp In sld.Shapes
        If Not IsPlaceholder(sld, shp) Then
            shps.Add shp.Name
        End If
    Next shp
    If shps.Count > 0 Then
        Dim shpsArray() As Variant
        shpsArray = CollectionToArray(shps)
        Set SelectAllShapes = sld.Shapes.Range(shpsArray)
    Else
        Set SelectAllShapes = Nothing
    End If
End Function

Sub CreateShapeGrid(ByRef sld As Slide, ByRef slideShapes As ShapeRange, _
                    ByVal gridTop As Long, ByVal gridLeft As Long, _
                    ByVal gridHeight As Long, ByVal gridWidth As Long)
    
    '--- position the group of shapes
    With slideShapes.Group
        .top = gridTop
        .left = gridLeft
        .LockAspectRatio = frmFitToGrid.chkAspectRatio
        .width = gridWidth
        .height = gridHeight
                
        If frmFitToGrid.optHeight = True Then
            .height = gridHeight
        End If
        'If .Width > GridWidth Then
        If frmFitToGrid.optWidth = True Then
            .width = gridWidth
        End If
                
        .Tags.Add "Type", "ZenSmartGroup"
        .Name = "ZenSmartGroup"
    End With
            
    '--- now create a grid over the shapes
    Dim grid As Shape
    Set grid = sld.Shapes.AddShape(msoShapeRectangle, gridLeft, gridTop, gridWidth, gridHeight)
    grid.Fill.Visible = msoFalse
    grid.Line.Visible = msoTrue
    grid.Line.ForeColor.RGB = RGB(0, 255, 0)
    grid.Line.Weight = 2.25
    'grid.Select
    grid.Name = "ZenWorkGrid"
    SelectShapes = Array("ZenSmartGroup", "ZenWorkGrid")
    'Set theseShapes = thisSlide.Shapes.Range(SelectShapes)
    'theseShapes.Align msoAlignMiddles, msoFalse
    'theseShapes.Align msoAlignCenters, msoFalse
            
    Set ZenSmartGroup = sld.Shapes("ZenSmartGroup")
    Set ZenWorkGrid = sld.Shapes("ZenWorkGrid")
            
    'Align Middle (Horizontal Center)
    '        If Not (frmFitToGrid.chkAlignLeft) Then
    '            ZenSmartGroup.Top = ZenWorkGrid.Top + ((ZenWorkGrid.Height - ZenSmartGroup.Height) / 2)
    '        End If
    '
    '        'Align Center (Vertical Center)
    '        If Not (frmFitToGrid.chkAlignTop) Then
    '            ZenSmartGroup.Left = ZenWorkGrid.Left + ((ZenWorkGrid.Width - ZenSmartGroup.Width) / 2)
    '        End If
            
    grid.Delete
    'ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoFalse
    'ActiveWindow.Selection.ShapeRange(1).Delete
    'ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
    slideShapes.Ungroup
End Sub