Discussion :

[dariusvba]

Bonjour à tous.
Je me présente, je m'apelle Darius je suis nouveau sur votre forum.
Je suis actuellement étudiant en Economie gestion mais je programme en Vba dans le cadre de ma licence.
Novice, j'ai quelques difficultés à résoudre cet exercice.
Je me permets de le poster ici au cas où quelqu'un aurait la bonté de m'aider .
Merci d'avance !

je serais vraiment reconnaissant pour vos réponses je ne maîtrise vraiment pas bien les boucles et malgré les connaisances que j'arrive à récoler sur d'autres sites je ne parviens pas à commencer à coder un tel programme... de plus je suis un peu pressé par le temp.
SVP UN PEU D'AIDE

[kiki29]

Salut, une fois de plus : Les règles du Club

Sinon à lire, assimiler et appliquer : La gestion des boucles dans Excel

[clementmarcotte]

Bonjour,

Là, tu viens d'enfreindre quelques règles du forum.

Pas de up tout de suite après avoir posé la question

Aucune indication sur ce que tu as déjà réalisé et aucun code fourni

Le forum exige des efforts de la part du demandeur et ne fournit pas de code gratuit clef en main.

Et puis le fait de se plaindre que c'est urgent, est plutôt irritant. Ceux qui répondent ici le font bénévolement.

[eriiic]

Bonjour,

D'accord avec les avis précédents : sors tes cours et met les mains dans le cambouis.
Si tu demandes déjà pour les boucles tu n'es pas arrivé au bout...
Tu dois faire un tableau qui représente le damier, en mettant dedans par exemple 0 pour vide, 1 pour blanc, 2 pour noir.
Bien que le damier fasse 8x8 je te conseille de faire un tableau 10x10. Comme tu devras tester au-dessus, au-dessous, à gauche et à droite, en faisant ainsi tu n'auras pas de dépassement d'indice à gérer sur les bords.
Ex :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim Table(0 To 9, 0 To 9)
Sub balayage()
    Dim lig As Long, col As Long, pion As Long
    For lig = 1 To 8
        For col = 1 To 8
            If Table(lig, col) = 1 Then MsgBox "Pion blanc en " & lig & ", " & col
            If Table(lig, col - 1) = 2 Then MsgBox "Pion noir à gauche de " & lig & ", " & col
        Next col
    Next lig
End Sub

edit : mis le Dim Table oublié

[kiki29]

Salut, une simple recherche donne pour vb net ( plus approprié que vba ) une myriade de solutions, bref tout faux.

[dariusvba]

Bonsoir et merci pour vos réponses.
J'ai commencé à essayer de coder ça donne ça pour l'instant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Type Pions 
       Couleur as string
End type 
 
 
Sub othello () 
 
    Const  longueur = 8
   Const largeur = 7
 
dim Tableauothello (  1 to longueur , 1 to largeur )  as string
Dim i as integer
Dim j as integer    
 
For i = 1 to longueur 
i = 1 to largeur 
cells(i,j).interior.colorindex=3
Next J 
Next I  
 
for i = 1 to longueur 
for j = 1 to largeur 
tableauothello(i,j) = ‘vide’’
next j 
next i
 
Tableauothello ( 4,5 ) = " noir"
Tableauothello( 5 , 4 ) = "" blanc "
 
End sud

Salut, une simple recherche donne pour vb net ( plus approprié que vba ) une myriade de solutions, bref tout faux.

Merci pour ta réponse de vb net mais je dois le faire en VBA.

[eriiic]

Re,

J'ai édité mon post, j'avais oublié le Dim Table(0 To 9, 0 To 9) qui va bien.
PS : un damier d'othello fait 8x8, pas 8x7

[Invité]

Bonjour,
pour information un jeu d’échec contient 64 cases, un jeu de dame 100 case mais que les case noir son utilisé 5X10 soit 5 pions par ligne en 10 lignes 50 cases!

[mercatog]

Sans se soucier des jetons, voici une proposition Excel, le jeux se fait par sélection d'une case du damier et à tour de rôle la case est soit noire ou blanche.

Préparation du fichier
Colorier A1:H8 en couleur verte olive
Appliquer une MFC sur la plage A1:H8 avec couleur noire si cellule =1 et blanche si cellule =2
Ajouter une bouton ActiveX qu'on nomme RAZ


Codes (à mettre dans le module de la feuille)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
Private Const N As Byte = 8    'Damier 8x8
 
Private Enum DIRECTION
    Haut
    Gauche
    Droite
    Bas
End Enum
 
Private Type PION
    Pos As Byte
    Dir As DIRECTION
End Type
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static Joueur As Boolean
 
If Not Intersect(Target, Range("A1").Resize(N, N)) Is Nothing Then
    If Target.Count = 1 Then
        If Target = "" Then
            Joueur = Not Joueur
            Target = 1 + Abs(Joueur)
            Check Target
        End If
    End If
End If
End Sub
 
Private Function LesVoisins(ByVal M As Integer) As PION()
Dim Tb() As PION
Dim P As Byte
 
If M - N > 0 Then
    P = P + 1
    ReDim Tb(1 To P)
    Tb(P).Pos = M - N
    Tb(P).Dir = Haut
End If
 
If M Mod N <> 1 Then
    P = P + 1
    ReDim Preserve Tb(1 To P)
    Tb(P).Pos = M - 1
    Tb(P).Dir = Gauche
End If
 
If M Mod N <> 0 Then
    P = P + 1
    ReDim Preserve Tb(1 To P)
    Tb(P).Pos = M + 1
    Tb(P).Dir = Droite
 
End If
 
If M + N < N * N Then
    P = P + 1
    ReDim Preserve Tb(1 To P)
    Tb(P).Pos = M + N
    Tb(P).Dir = Bas
End If
 
LesVoisins = Tb
End Function
 
Private Sub Check(ByVal v As Range)
Dim i As Byte, j As Byte, k As Byte
Dim T1() As PION, T2() As PION
Dim c As Range
 
Set c = Range("A1").Resize(N, N)
For i = 1 To N * N
    If c(i).Address = v.Address Then Exit For
Next i
 
T1 = LesVoisins(i)
For j = 1 To UBound(T1)
    If c(T1(j).Pos) * c(i) = 2 Then
        T2 = LesVoisins(T1(j).Pos)
        For k = 1 To UBound(T2)
            If c(T2(k).Pos) * c(T1(j).Pos) = 2 And T2(k).Dir = T1(j).Dir Then
                c(T1(j).Pos) = c(i)
                Exit For
            End If
        Next k
    End If
Next j
If Application.Count(c) = N * N Then MsgBox "Partie terminée"
Set c = Nothing
End Sub
 
Private Sub RAZ_Click()
Dim a As Byte, b As Byte
Dim c As Range
 
Set c = Range("A1").Resize(N, N)
c.ClearContents
 
Randomize
a = IIf(Rnd() < 0.5, 1, 2)
b = IIf(a = 1, 2, 1)
 
c(4, 4) = a
c(4, 5) = b
c(5, 4) = b
c(5, 5) = a
c.Select
Set c = Nothing
End Sub

Fichier démo