PDA

Archiv verlassen und diese Seite im Standarddesign anzeigen : Quellcode "Vier Gewinnt" [Wichtig! S: Hilfe]



roccihrs
27.04.2010, 16:35
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 (http://www.excel-center.de/foren/file.php?4,file=9624)

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
27.04.2010, 17:05
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
27.04.2010, 17:21
Hör auf zu labern. Ich habe hier nicht nach kostenlosen Predigungen gefragt!

s1rX
27.04.2010, 17:28
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
27.04.2010, 17:52
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