Quellcode "Vier Gewinnt" [Wichtig! S: Hilfe]

[roccihrs]

Hallo,

Ich habe hier einen Quellcode für meine

Modul1
-----------------------
Option Explicit

Sub Spielstart()
Dim Spieler1 As String
Dim Spieler2 As String

Sheets(1).Range("A3:G8").Clear
Sheets(2).Range("A3:G8").ClearContents
With Sheets(1).Range("A3:G8").Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Sheets(1).Range("A3:G8").Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With Sheets(1).Range("A3:G8").Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Sheets(1).Range("A3:G8").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Sheets(1).Range("A3:G8").Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Sheets(1).Range("A3:G8").Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
Spieler1 = InputBox("Bitte geben Sie den Namen des 1. Spielers ein", _
"Spieler 1", Cells(2, 9))
Spieler2 = InputBox("Bitte geben Sie den Namen des 2. Spielers ein", _
"Spieler 2", Cells(2, 10))
Cells(2, 9) = Spieler1
Cells(2, 10) = Spieler2
Cells(4, 12) = 3
End Sub


Sub ZugMachen()
Dim Spalte As Integer
Dim i As Integer
Dim Zelle As Range
Dim NeuesSpiel As Integer

'On Error Resume Next
Spalte = Selection.Column

'Spaltenprüfung: Ist die Spalte voll?
If Cells(3, Spalte).Interior.ColorIndex <> -4142 Then
    MsgBox "Sorry, diese Spalte ist schon voll!" & _
    vbLf & "Bitte wählen Sie eine andere", vbOKOnly
    Exit Sub
End If

'Spielstein setzen
For i = 8 To 3 Step -1
    If Cells(i, Spalte).Interior.ColorIndex = -4142 Then
        Cells(i, Spalte).Interior.ColorIndex = Cells(4, 12)
        Sheets(2).Cells(i, Spalte) = _
        Sheets(1).Cells(i, Spalte).Interior.ColorIndex
        Exit For
    End If
Next

'Spiel prüfen
For Each Zelle In Sheets(2).Range("A3:K14")
    If Zelle = 12 Then
        MsgBox Cells(2, 9) & " hat gewonnen!"
        NeuesSpiel = MsgBox("Neues Spiel?", vbYesNo, "Nochmal?")
            If NeuesSpiel = vbYes Then
                Call Spielstart
            Else
                Exit Sub
            End If
    ElseIf Zelle = 20 Then
        MsgBox Cells(2, 10) & " hat gewonnen!"
        NeuesSpiel = MsgBox("Neues Spiel?", vbYesNo, "Nochmal?")
            If NeuesSpiel = vbYes Then
                Call Spielstart
            Else
                Exit Sub
            End If
    End If
Next
 
'Spielerwechsel
If Cells(4, 12) = 3 Then
    Cells(4, 12) = 5
    Else
    Cells(4, 12) = 3
End If

End Sub

----------------------
Modul2

---------------

Option Explicit

Sub Makro4()


ActiveSheet.ClearArrows
    Selection.ShowPrecedents

End Sub

DIESE ARBEITSMAPPE
----------

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Aktiv As Integer
Aktiv = Selection.Column

Set Target = Intersect(Target, Sheets(1).Range("A2:G2"))
If Target Is Nothing Then
'MsgBox "Bitte lassen Sie den Cursor im gelben Bereich."
    If Aktiv > 7 Then
        Aktiv = 7
    End If
Cells(2, Aktiv).Select
End If
End Sub

Download als fertige Excel-Datei: excel-center Foren :: Beispieldateien Microsoft Excel

Für jeden, der mir die einzelnen Befehle erklären kann oder sie umformulieren kann, gibts einen Usenext Account (keinen Trial Account)!

Ich muss die Commands erklären können und den Code umändern, damit er so aussieht, als hätte ich ihn geschrieben =)

MfG
roccihrs