Zbuduj Swój
Park Rozrywki!

Sub GenerujGreParkRozrywki()
    Dim pptPres As Presentation
    Set pptPres = ActivePresentation
    
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer, row As Integer, col As Integer
    
    Dim titles(1 To 15) As String, descs(1 To 15) As String, equations(1 To 15) As String
    Dim optA(1 To 15) As String, optB(1 To 15) As String, optC(1 To 15) As String
    Dim correctOpt(1 To 15) As Integer
    
    titles(1) = "Zadanie 1 – Wielka Zjeżdżalnia": descs(1) = "Na planie zjeżdżalnia ma długość 4 cm. Skala wynosi 1 cm = 2 m."
    equations(1) = "4 cm × 2 m = ? m": optA(1) = "A) 6 m": optB(1) = "B) 8 m": optC(1) = "C) 4 m": correctOpt(1) = 2
    
    titles(2) = "Zadanie 2 – Karuzela z Konikami": descs(2) = "Średnica karuzeli na planie wynosi 3 cm. Skala to 1 cm = 2 m."
    equations(2) = "3 cm × 2 m = ? m": optA(2) = "A) 6 m": optB(2) = "B) 5 m": optC(2) = "C) 8 m": correctOpt(2) = 1
    
    titles(3) = "Zadanie 3 – Ogromny Diabelski Młyn": descs(3) = "Wysokość koła na rysunku to 5 cm. Skala wynosi 1 cm = 3 m."
    equations(3) = "5 cm × 3 m = ? m": optA(3) = "A) 10 m": optB(3) = "B) 12 m": optC(3) = "C) 15 m": correctOpt(3) = 3
    
    titles(4) = "Zadanie 4 – Strefa Wodna": descs(4) = "Długość basenu na planie wynosi 6 cm. Skala: 1 cm = 2 m."
    equations(4) = "6 cm × 2 m = ? m": optA(4) = "A) 12 m": optB(4) = "B) 8 m": optC(4) = "C) 14 m": correctOpt(4) = 1
    
    titles(5) = "Zadanie 5 – Nawiedzony Zamek": descs(5) = "Szerokość budynku na planie to 4 cm. Skala to 1 cm = 3 m."
    equations(5) = "4 cm × 3 m = ? m": optA(5) = "A) 7 m": optB(5) = "B) 12 m": optC(5) = "C) 16 m": correctOpt(5) = 2
    
    titles(6) = "Zadanie 6 – Szalony Rollercoaster": descs(6) = "Tor kolejki na planie ma długość 8 cm. Skala to 1 cm = 2 m."
    equations(6) = "8 cm × 2 m = ? m": optA(6) = "A) 16 m": optB(6) = "B) 10 m": optC(6) = "C) 18 m": correctOpt(6) = 1
    
    titles(7) = "Zadanie 7 – Autka Elektryczne": descs(7) = "Długość toru autek wynosi na planie 3 cm. Skala: 1 cm = 3 m."
    equations(7) = "3 cm × 3 m = ? m": optA(7) = "A) 6 m": optB(7) = "B) 9 m": optC(7) = "C) 12 m": correctOpt(7) = 2
    
    titles(8) = "Zadanie 8 – Budka z Lodami": descs(8) = "Szerokość stoiska z lodami na rysunku to 2 cm. Skala wynosi 1 cm = 3 m."
    equations(8) = "2 cm × 3 m = ? m": optA(8) = "A) 5 m": optB(8) = "B) 8 m": optC(8) = "C) 6 m": correctOpt(8) = 3
    
    titles(9) = "Zadanie 9 – Park Trampolin": descs(9) = "Strefa skakania na planie ma 5 cm. Skala: 1 cm = 2 m."
    equations(9) = "5 cm × 2 m = ? m": optA(9) = "A) 10 m": optB(9) = "B) 7 m": optC(9) = "C) 12 m": correctOpt(9) = 1
    
    titles(10) = "Zadanie 10 – Labirynt z Żywopłotu": descs(10) = "Ściana labiryntu ma na rysunku 7 cm. Skala to 1 cm = 3 m."
    equations(10) = "7 cm × 3 m = ? m": optA(10) = "A) 21 m": optB(10) = "B) 14 m": optC(10) = "C) 10 m": correctOpt(10) = 1
    
    titles(11) = "Zadanie 11 – Strzelnica z Pluszakami": descs(11) = "Stoisko ma na planie 3 cm. Skala to 1 cm = 2 m."
    equations(11) = "3 cm × 2 m = ? m": optA(11) = "A) 5 m": optB(11) = "B) 6 m": optC(11) = "C) 9 m": correctOpt(11) = 2
    
    titles(12) = "Zadanie 12 – Budynek Kina 7D": descs(12) = "Ściana kina na planie ma długość 6 cm. Skala wynosi 1 cm = 3 m."
    equations(12) = "6 cm × 3 m = ? m": optA(12) = "A) 18 m": optB(12) = "B) 9 m": optC(12) = "C) 15 m": correctOpt(12) = 1
    
    titles(13) = "Zadanie 13 – Huśtawka Łódź": descs(13) = "Szerokość huśtawki na rysunku to 4 cm. Skala: 1 cm = 2 m."
    equations(13) = "4 cm × 2 m = ? m": optA(13) = "A) 6 m": optB(13) = "B) 8 m": optC(13) = "C) 10 m": correctOpt(13) = 2
    
    titles(14) = "Zadanie 14 – Kawiarnia Rodzinna": descs(14) = "Taras kawiarni na planie wynosi 5 cm. Skala: 1 cm = 3 m."
    equations(14) = "5 cm × 3 m = ? m": optA(14) = "A) 15 m": optB(14) = "B) 8 m": optC(14) = "C) 12 m": correctOpt(14) = 1
    
    titles(15) = "Zadanie 15 – Brama Główna Parku": descs(15) = "Szerokość bramy na rysunku wynosi 9 cm. Skala: 1 cm = 2 m."
    equations(15) = "9 cm × 2 m = ? m": optA(15) = "A) 11 m": optB(15) = "B) 16 m": optC(15) = "C) 18 m": correctOpt(15) = 3

    Set sld = pptPres.Slides.Add(1, ppLayoutBlank)
    Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 150, 760, 100)
    shp.TextFrame.TextRange.Text = "BUDOWNICZY PARKU ROZRYWKI"
    shp.TextFrame.TextRange.Font.Size = 40
    
    Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, 330, 300, 300, 80)
    shp.TextFrame.TextRange.Text = "START GRA"
    shp.ActionSettings(ppMouseClick).Action = ppActionNextSlide

    Set sld = pptPres.Slides.Add(2, ppLayoutBlank)
    For i = 1 To 15
        row = (i - 1) \ 5: col = (i - 1) Mod 5
        Set shp = sld.Shapes.AddShape(msoShapeOval, 120 + (col * 140), 120 + (row * 130), 90, 90)
        shp.TextFrame.TextRange.Text = "Zadanie " & i
        shp.ActionSettings(ppMouseClick).Action = ppActionHyperlink
        shp.ActionSettings(ppMouseClick).Hyperlink.SubAddress = (i + 2) & "," & i + 2 & ",Zadanie " & i
    Next i

    For i = 1 To 15
        Set sld = pptPres.Slides.Add(i + 2, ppLayoutBlank)
        Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 40, 860, 50)
        shp.TextFrame.TextRange.Text = titles(i)
        
        Dim optText As String, k As Integer
        For k = 1 To 3
            Select Case k: Case 1: optText = optA(i): Case 2: optText = optB(i): Case 3: optText = optC(i): End Select
            Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, 80, 260 + (k * 70), 800, 55)
            shp.TextFrame.TextRange.Text = optText
            If k = correctOpt(i) Then
                shp.ActionSettings(ppMouseClick).Action = ppActionHyperlink
                shp.ActionSettings(ppMouseClick).Hyperlink.SubAddress = "2,2,Mapa Parku"
            End If
        Next k
    Next i

    Set sld = pptPres.Slides.Add(18, ppLayoutBlank)
    MsgBox "Gotowe!", vbInformation
End Sub