Option Explicit

Const ppLayoutTitleAndContent As Long = 2  ' Usually "Title and Content" layout index
Const msoTrue As Long = -1                ' For bullet = Visible

Sub ConvertWordToPowerPoint_HeadingNormalNotes()
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    
    ' Attempt to get or create an instance of PowerPoint
    On Error Resume Next
    Set ppApp = GetObject(Class:="PowerPoint.Application")
    If ppApp Is Nothing Then
        Set ppApp = New PowerPoint.Application
    End If
    On Error GoTo 0
    
    ppApp.Visible = True
    
    ' Create a new presentation
    Set ppPres = ppApp.Presentations.Add
    
    ' Loop through every paragraph in the active Word doc
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        
        ' Get paragraph text, trimmed of whitespace
        Dim textContent As String
        textContent = Trim(para.Range.Text)
        
        ' Skip empty paragraphs
        If Len(textContent) = 0 Then GoTo SkipPara
        
        ' Check the style name
        Select Case True
            
            ' == 1) Heading 1 => New Slide Title ==
            Case para.Style = ActiveDocument.Styles("Heading 1")
                Set ppSlide = ppPres.Slides.Add(ppPres.Slides.Count + 1, ppLayoutTitleAndContent)
                ppSlide.Shapes.Title.TextFrame.TextRange.Text = textContent
            
            ' == 2) Normal Style => Bullet Points ==
            Case para.Style = ActiveDocument.Styles("Normal")
                If Not ppSlide Is Nothing Then
                    With ppSlide.Shapes.Placeholders(2).TextFrame.TextRange
                        .ParagraphFormat.Bullet.Visible = msoTrue
                        
                        ' Optionally remove extra spacing around bullets:
                        .ParagraphFormat.SpaceBefore = 0
                        .ParagraphFormat.SpaceAfter = 0
                        
                        ' Append the bullet text
                        If Len(.Text) = 0 Then
                            .Text = textContent
                        Else
                            .InsertAfter vbCrLf & textContent
                        End If
                    End With
                End If
            
            ' == 3) Custom "Notes" Style => Slide Notes ==
            Case para.Style = ActiveDocument.Styles("Notes")
                If Not ppSlide Is Nothing Then
                    Dim notesTR As PowerPoint.TextRange
                    Set notesTR = ppSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange
                    
                    If Len(notesTR.Text) = 0 Then
                        notesTR.Text = textContent
                    Else
                        notesTR.InsertAfter vbCrLf & textContent
                    End If
                End If
            
            ' == Anything else => ignore ==
        End Select
        
SkipPara:
    Next para
    
    MsgBox "Conversion complete! Check your new PowerPoint presentation.", vbInformation
End Sub