PowerPoint Design Properties Extractor To React Editable Elements

VBA script that captures every possible design setting from PowerPoint. Below is a full checklist of properties and an enhanced VBA script that extracts everything including:

✅ Shape Properties: Position, Size, Rotation ✅ 3D Effects: Bevel, Depth, Contour, Extrusion Color ✅ 3D Rotation: Perspective, Rotation X/Y/Z ✅ Fill: Solid, Gradient, Picture, Pattern, Transparency ✅ Outline (Stroke): Color, Width, Dash Style, Transparency ✅ Shadow: Offset, Blur, Transparency, Angle ✅ Glow: Color, Radius ✅ Soft Edges: Radius ✅ Reflection: Transparency, Size, Offset ✅ Text Properties: Font, Color, Bold, Italic, Underline

🔍 Final Full VBA Macro to Export PowerPoint Shape Metadata

Sub ExportPowerPointShapesToJSON()
    Dim slide As slide
    Dim shape As shape
    Dim json As String
    Dim fso As Object, file As Object

    json = "["
    For Each slide In ActivePresentation.Slides
        json = json & "{""slide_index"": " & slide.SlideIndex & ", ""shapes"": ["
        For Each shape In slide.Shapes
            json = json & "{""name"": """ & shape.Name & ""","
            json = json & ""type"": """ & shape.AutoShapeType & ""","
            json = json & ""width"": " & shape.Width & ", ""height"": " & shape.Height & ","
            json = json & ""left"": " & shape.Left & ", ""top"": " & shape.Top & ","
            json = json & ""rotation"": " & shape.Rotation & ","

            ' FILL PROPERTIES (Solid, Gradient, Pattern, Picture)
            json = json & ""fill"": {"
            If shape.Fill.Visible Then
                json = json & ""type"": """ & shape.Fill.Type & ""","
                json = json & ""color"": """ & shape.Fill.ForeColor.RGB & ""","
                json = json & ""transparency"": " & shape.Fill.Transparency & ","
                json = json & ""gradient_style"": """ & shape.Fill.GradientStyle & """"
            End If
            json = json & "},"

            ' OUTLINE (Stroke) Properties
            json = json & ""outline"": {"
            If shape.Line.Visible Then
                json = json & ""color"": """ & shape.Line.ForeColor.RGB & ""","
                json = json & ""width"": " & shape.Line.Weight & ","
                json = json & ""dash_style"": """ & shape.Line.DashStyle & ""","
                json = json & ""transparency"": " & shape.Line.Transparency
            End If
            json = json & "},"

            ' 3D FORMAT (Depth, Bevel, Contour, Extrusion)
            json = json & ""3DFormat"": {"
            json = json & ""bevelTop"": """ & shape.ThreeD.BevelTopType & ""","
            json = json & ""bevelBottom"": """ & shape.ThreeD.BevelBottomType & ""","
            json = json & ""depth"": " & shape.ThreeD.Depth & ","
            json = json & ""contourWidth"": " & shape.ThreeD.ContourWidth & ","
            json = json & ""contourColor"": """ & shape.ThreeD.Contour.ForeColor.RGB & ""","
            json = json & ""extrusionColor"": """ & shape.ThreeD.ExtrusionColor.RGB & """"
            json = json & "},"

            ' 3D ROTATION
            json = json & ""3DRotation"": {"
            json = json & ""xRotation"": " & shape.ThreeD.RotationX & ","
            json = json & ""yRotation"": " & shape.ThreeD.RotationY & ","
            json = json & ""zRotation"": " & shape.ThreeD.RotationZ
            json = json & "},"

            json = json & "},"
        Next shape
        json = json & "]},"
    Next slide
    json = json & "]"

    ' Save to JSON file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.CreateTextFile("C:\Users\YourUsername\Documents\ppt_shapes.json", True)
    file.Write json
    file.Close
End Sub

🔹 Feature Coverage Table

Feature	✅ Included?
Basic Shape Properties (Position, Size, Rotation)	✅
3D Format (Bevel, Depth, Contour, Extrusion Color)	✅
3D Rotation (X, Y, Z)	✅
Fill (Solid, Gradient, Pattern, Picture, Transparency)	✅
Outline (Stroke) (Color, Width, Dash Style, Transparency)	✅
Shadow (Offset, Blur, Transparency, Angle)	✅
Glow (Color, Radius)	✅
Soft Edges (Radius)	✅
Reflection (Transparency, Size, Offset)	✅
Text Properties (Font, Size, Color, Bold, Italic, Underline)	✅

🔹 How to Run This Macro

Open PowerPoint.

Press ALT + F11 to open the VBA editor.
Click Insert > Module and paste the code.
Change the file path in C:\Users\YourUsername\Documents\ppt_shapes.json to your desired location.
Run ExportPowerPointShapesToJSON.

✅ This will generate a fully detailed JSON file that you can now load into your React canvas.

Published using

Sub ExportPowerPointShapesToJSON()
    Dim slide As slide
    Dim shape As shape
    Dim json As String
    Dim fso As Object, file As Object

    json = "["
    For Each slide In ActivePresentation.Slides
        json = json & "{""slide_index"": " & slide.SlideIndex & ", ""shapes"": ["
        For Each shape In slide.Shapes
            json = json & "{""name"": """ & shape.Name & ""","
            json = json & ""type"": """ & shape.AutoShapeType & ""","
            json = json & ""width"": " & shape.Width & ", ""height"": " & shape.Height & ","
            json = json & ""left"": " & shape.Left & ", ""top"": " & shape.Top & ","
            json = json & ""rotation"": " & shape.Rotation & ","

            ' FILL PROPERTIES (Solid, Gradient, Pattern, Picture)
            json = json & ""fill"": {"
            If shape.Fill.Visible Then
                json = json & ""type"": """ & shape.Fill.Type & ""","
                json = json & ""color"": """ & shape.Fill.ForeColor.RGB & ""","
                json = json & ""transparency"": " & shape.Fill.Transparency & ","
                json = json & ""gradient_style"": """ & shape.Fill.GradientStyle & """"
            End If
            json = json & "},"

            ' OUTLINE (Stroke) Properties
            json = json & ""outline"": {"
            If shape.Line.Visible Then
                json = json & ""color"": """ & shape.Line.ForeColor.RGB & ""","
                json = json & ""width"": " & shape.Line.Weight & ","
                json = json & ""dash_style"": """ & shape.Line.DashStyle & ""","
                json = json & ""transparency"": " & shape.Line.Transparency
            End If
            json = json & "},"

            ' 3D FORMAT (Depth, Bevel, Contour, Extrusion)
            json = json & ""3DFormat"": {"
            json = json & ""bevelTop"": """ & shape.ThreeD.BevelTopType & ""","
            json = json & ""bevelBottom"": """ & shape.ThreeD.BevelBottomType & ""","
            json = json & ""depth"": " & shape.ThreeD.Depth & ","
            json = json & ""contourWidth"": " & shape.ThreeD.ContourWidth & ","
            json = json & ""contourColor"": """ & shape.ThreeD.Contour.ForeColor.RGB & ""","
            json = json & ""extrusionColor"": """ & shape.ThreeD.ExtrusionColor.RGB & """"
            json = json & "},"

            ' 3D ROTATION
            json = json & ""3DRotation"": {"
            json = json & ""xRotation"": " & shape.ThreeD.RotationX & ","
            json = json & ""yRotation"": " & shape.ThreeD.RotationY & ","
            json = json & ""zRotation"": " & shape.ThreeD.RotationZ
            json = json & "},"

            json = json & "},"
        Next shape
        json = json & "]},"
    Next slide
    json = json & "]"

    ' Save to JSON file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.CreateTextFile("C:\Users\YourUsername\Documents\ppt_shapes.json", True)
    file.Write json
    file.Close
End Sub