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

[firefox15]

wie wäre es wenn du dich eifnach selber informierst und eins schreibst und nicht von jemanden was hernimmst um es zu ändern und bei freunden dann auf dicke hose zu machen

sorry aber es ist einfach so, ich lern selber momentan ohne ende des zeug um mir fertigkeiten anzueignen und wenn dann jemand kommt und was ändern will dass es aussieht als wäre es von ihm finde ichs echt scheiße

[roccihrs]

Hör auf zu labern. Ich habe hier nicht nach kostenlosen Predigungen gefragt!

[s1rX]

wenn er hilfe braucht helft ihn doch
und nich immer rum labern von wegen lern selber

jeder fragt kannst du mir nich erzählen das du FIREFOX15 das nicht gemacht hast

aber sorrx digger ich kann dir nich weiter helfen

[H4x0r007]

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

Handel außerhalb des BM. Außerdem machen wir nicht deine Hausaufgaben. Besonders der Basic angelehnte Code ist relativ einfach zu verstehen. Google spuckt bei den Suchworten Excel Scripting Tutorial schon einiges aus.

Auf Wunsch geschlossen