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