1. create 9 rectangle shape and change the name of shape by using selection pane with cell1,cell2,cell3,........,cell9
2. copy code and paste in module (devloper-visual basic-insert-module) and save with "name.pptm"
3. then select each shape and change action by action setting cell1 - cell1_click, cell2- cell2_click........
4. and create a new shape and set action by using action setting resetgame on mouse click



Option Explicit

' board: 0 = empty, 1 = X, 2 = O
Dim board(1 To 9) As Integer
Dim currentPlayer As Integer  ' 1 = X, 2 = O

' Initialize / Reset the game
Sub ResetGame()
    Dim i As Integer
    currentPlayer = 1 ' X starts
    For i = 1 To 9
        board(i) = 0
        With ActivePresentation.Slides(1).Shapes("Cell" & i)
            .TextFrame.TextRange.Text = ""
            .TextFrame.TextRange.Font.Size = 48
            .TextFrame.TextRange.Font.Bold = msoTrue
            .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
            .TextFrame.VerticalAnchor = msoAnchorMiddle
            ' Enable click action to call corresponding macro
            .ActionSettings(ppMouseClick).Action = ppActionRunMacro
            .ActionSettings(ppMouseClick).Run = "Cell" & i & "_Click"
            ' reset fill/line (optional)
            '.Fill.ForeColor.RGB = RGB(255, 255, 255)
            '.Line.ForeColor.RGB = RGB(0, 0, 0)
        End With
    Next i
End Sub

' Individual shape macros — each calls the shared handler with index
Sub Cell1_Click(): CellClicked 1: End Sub
Sub Cell2_Click(): CellClicked 2: End Sub
Sub Cell3_Click(): CellClicked 3: End Sub
Sub Cell4_Click(): CellClicked 4: End Sub
Sub Cell5_Click(): CellClicked 5: End Sub
Sub Cell6_Click(): CellClicked 6: End Sub
Sub Cell7_Click(): CellClicked 7: End Sub
Sub Cell8_Click(): CellClicked 8: End Sub
Sub Cell9_Click(): CellClicked 9: End Sub

' Common handler when a cell is clicked
Sub CellClicked(ByVal idx As Integer)
    If board(idx) <> 0 Then Exit Sub ' already taken

    board(idx) = currentPlayer
    Dim s As Shape
    Set s = ActivePresentation.Slides(1).Shapes("Cell" & idx)

    If currentPlayer = 1 Then
        s.TextFrame.TextRange.Text = "X"
    Else
        s.TextFrame.TextRange.Text = "O"
    End If

    s.TextFrame.TextRange.Font.Size = 48
    s.TextFrame.TextRange.Font.Bold = msoTrue
    s.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
    s.TextFrame.VerticalAnchor = msoAnchorMiddle

    ' disable further clicks on this cell
    s.ActionSettings(ppMouseClick).Action = ppActionNone

    ' check for win
    If CheckWin(currentPlayer) Then
        Dim winnerText As String
        If currentPlayer = 1 Then winnerText = "X (Cross) जीता!"
        If currentPlayer = 2 Then winnerText = "O (Zero) जीता!"
        MsgBox winnerText, vbInformation, "Game Over"
        HighlightWinner currentPlayer
        DisableAllCells
        Exit Sub
    End If

    ' check for draw
    If IsBoardFull() Then
        MsgBox "Draw! (बराबरी)", vbInformation, "Game Over"
        Exit Sub
    End If

    ' switch player
    currentPlayer = 3 - currentPlayer ' toggles 1 <-> 2
End Sub

' Check all winning combinations for player p
Function CheckWin(ByVal p As Integer) As Boolean
    CheckWin = False
    Dim b As Variant
    b = board
    ' Rows
    If b(1) = p And b(2) = p And b(3) = p Then CheckWin = True: Exit Function
    If b(4) = p And b(5) = p And b(6) = p Then CheckWin = True: Exit Function
    If b(7) = p And b(8) = p And b(9) = p Then CheckWin = True: Exit Function
    ' Columns
    If b(1) = p And b(4) = p And b(7) = p Then CheckWin = True: Exit Function
    If b(2) = p And b(5) = p And b(8) = p Then CheckWin = True: Exit Function
    If b(3) = p And b(6) = p And b(9) = p Then CheckWin = True: Exit Function
    ' Diagonals
    If b(1) = p And b(5) = p And b(9) = p Then CheckWin = True: Exit Function
    If b(3) = p And b(5) = p And b(7) = p Then CheckWin = True: Exit Function
End Function

' Return True if no empty cells
Function IsBoardFull() As Boolean
    Dim i As Integer
    For i = 1 To 9
        If board(i) = 0 Then
            IsBoardFull = False
            Exit Function
        End If
    Next i
    IsBoardFull = True
End Function

' Disable clicks on every cell (used after win)
Sub DisableAllCells()
    Dim i As Integer
    For i = 1 To 9
        ActivePresentation.Slides(1).Shapes("Cell" & i).ActionSettings(ppMouseClick).Action = ppActionNone
    Next i
End Sub

' (Optional) Highlight the winning line by coloring shapes that belong to winning combo
Sub HighlightWinner(ByVal p As Integer)
    Dim combos(1 To 8, 1 To 3) As Integer
    combos(1, 1) = 1: combos(1, 2) = 2: combos(1, 3) = 3
    combos(2, 1) = 4: combos(2, 2) = 5: combos(2, 3) = 6
    combos(3, 1) = 7: combos(3, 2) = 8: combos(3, 3) = 9
    combos(4, 1) = 1: combos(4, 2) = 4: combos(4, 3) = 7
    combos(5, 1) = 2: combos(5, 2) = 5: combos(5, 3) = 8
    combos(6, 1) = 3: combos(6, 2) = 6: combos(6, 3) = 9
    combos(7, 1) = 1: combos(7, 2) = 5: combos(7, 3) = 9
    combos(8, 1) = 3: combos(8, 2) = 5: combos(8, 3) = 7

    Dim c As Integer, i As Integer
    For c = 1 To 8
        If board(combos(c, 1)) = p And board(combos(c, 2)) = p And board(combos(c, 3)) = p Then
            For i = 1 To 3
                With ActivePresentation.Slides(1).Shapes("Cell" & combos(c, i))
                    .Fill.ForeColor.RGB = RGB(255, 255, 150) ' light highlight (optional)
                End With
            Next i
            Exit Sub
        End If
    Next c
End Sub