Encore un Labyrinthe :)

tototiti2008

XLDnaute Barbatruc
Bonjour à toutes et tous,

Sans doute parce qu'il s'agit d'un cas d'école, je me suis posé la question :
et si on voulait générer un labyrinthe avec VBA, quel serait la logique à employer, et là... j'ai un peu séché
Alors je suis tombé sur cette page : Labyrinthes
Et j'ai essayé d'utiliser le premier algorithme (unicité de chemin et aléa), en le mettant un peu à ma sauce (je ne peux pas m'en empêcher :D)
Puis la suite logique était de résoudre le labyrinthe ainsi créé...
Je vous livre le résultat qui semble fonctionner, et si quelqu'un est intéressé, je peux décrire la méthode employée pour chacun des algorithmes. Pas sûr que la méthode soit la plus optimisée mais ça marche :)
Dans la première feuille du classeur fourni, il vous est possible de redéfinir le nom "Labyrinthe" ce qui permettra de générer des labyrinthes de la taille de votre choix
 

Pièces jointes

  • Labyrinthe.xls
    96.5 KB · Affichages: 327

Modeste geedee

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

bonsour®
Bonjour à toutes et tous,
Sans doute parce qu'il s'agit d'un cas d'école, je me suis posé la question :
et si on voulait générer un labyrinthe avec VBA, quel serait la logique à employer, et là... j'ai un peu séché

autre approche (tout de mon crû...)
Le labyrinthe du minotaure | www.excelabo.net
 

JCGL

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonjour à tous,
Salut Marc,
Salut Geedee,

Marc : Puis-je me permettre ?

Pour les bordures :
VB:
Sub Efface()    'Efface toutes les bordures de la plage
    With Range("Labyrinthe")
        .Borders.LineStyle = xlNone
        .ClearContents
    End With
End Sub


Sub Remplir()
    'Remplit les bordures de la plage
    With Range("Labyrinthe")
        .Borders.LineStyle = xlContinuous
    End With
End Sub

Les générations antérieures avec Résoudre coché ne sont pas effacées

A+++ l'ami
A + à tous
 

ya_v_ka

XLDnaute Impliqué
Re : Encore un Labyrinthe :)

Hello tous

Le prog a buggé au 25e essai avec la configuration selon l'image...

Ya'v
 

Pièces jointes

  • Lab.jpg
    Lab.jpg
    61.4 KB · Affichages: 226

MJ13

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonjour à tous

Félicitations Tototiti pour cet exploit Vbaïstique :). J'ai juste testé une ou deux fois. Sur XL2007, pas de bugs.

Après, il faudra penser au Pac-Man ;).

Ce qui serait bien c'est qu'on puisse choisir le nombre de cellules de la matrice :confused:.

PS1: Pour Modeste Geedee, il serait plus simple de mettre ton labyrinthe sur XLD :).

PS2:
@ Michel : On peut choisir la taille du labyrinthe en redéfinissant le nom "Labyrinthe", mais je pourrais l'automatiser...

Ah, OK, j'ai compris :eek: , Cool :).
 
Dernière édition:

tototiti2008

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonjour à tous,

@Modeste GD : j'irai lire ton lien avec intérêt dès qu'Excel Labo sera disponible :)

@JC : Merci pour ce raccourcis :)
Les générations antérieures avec Résoudre coché ne sont pas effacées
euh dans la version originale plus longue je remet du jaune partout avec
.Interior.ColorIndex = 36
.ClearContents

@ ya_v_ka : il a buggé ? quel message d'erreur ?

@ Michel : On peut choisir la taille du labyrinthe en redéfinissant le nom "Labyrinthe", mais je pourrais l'automatiser...
 
Dernière édition:

ya_v_ka

XLDnaute Impliqué
Re : Encore un Labyrinthe :)

Hello

Erreur d'execution 9 :

Sub DessineChemins()
'Dessine les derniers points des chemins testés
Dim i As Long, X As Long, Y As Long
With Range("Labyrinthe")
For i = 1 To UBound(Chemins, 2)
If Chemins(1, i) <> "X" Then'*************************
X = Chemins(2, i)(1, UBound(Chemins(2, i), 2))
Y = Chemins(2, i)(2, UBound(Chemins(2, i), 2))
.Cells(X, Y).Interior.ColorIndex = 4
DoEvents
End If
Next i
End With
End Sub

Ya'v
 

ya_v_ka

XLDnaute Impliqué
Re : Encore un Labyrinthe :)

Hello Tototiti,

Je confirme, lorsque l'E est sur la cellule contiguë au S ça bug ! Certainement par manque de chemin...

Ya'v
 

ya_v_ka

XLDnaute Impliqué
Re : Encore un Labyrinthe :)

Re

Alors j'ai reproduis 2 x (sur près de 300 essais) sans que cela ne pose problème ces fois...

Par contre si par malheur on re-clique sur générer avant la fin une erreur est générée à la fin de la nouvelle génération.

Ya'v
 

Misange

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Super :)
Ah oui un pac man, un pac man, un pac man ! :)

(PS excelabo a eu des hoquets hier après midi puis c'est retombé en marche)
 

tototiti2008

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonjour à tous :),

@ Ya'v : Je crois que j'ai réussi à reproduire ton erreur en re-cliquant trop vite sur le bouton Générer
S'il y a une petite attente à la fin c'est qu'il dessine le 2ème labyrinthe sur la seconde feuille (dernière case à cocher)
Pour éviter les clics en cours de macro je pourrais peut-être éviter les DoEvents qui rendent la main à l'utilisateur...
sinon sans relancer en cours de génération je n'ai pas réussi à le faire planter

@ Modeste GD : Je regarderais ton code pour générer ton labyrinthe, toujours intéressant de voir la logique employée

Merci de votre intérêt, dites-moi si vous voulez que j'explique une partie ou une autre du code, ou les principes utilisés :)
 

Modeste geedee

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonsour®
Super :)
Ah oui un pac man, un pac man, un pac man ! :)

il y a quelques années...
j'avais récupéré ceci :
Capture.jpg
un pacman japonais de ?? chikida
il me semble que le site n'existe plus
mais j'ai retrouvé l'archive plus vrai que nature ... :cool:

le code n'est pas verrouillé mais les explications et commentaires sont en nippon...
pas simple à interpréter et intervenir dans le code
 

Pièces jointes

  • Capture.jpg
    Capture.jpg
    45.8 KB · Affichages: 311
  • Capture.jpg
    Capture.jpg
    45.8 KB · Affichages: 289
  • pacelle.zip
    290.7 KB · Affichages: 117

Misange

XLDnaute Barbatruc
Re : Encore un Labyrinthe :)

Bonsour®

il y a quelques années...
j'avais récupéré ceci :
Regarde la pièce jointe 246454
un pacman japonais de ?? chikida
il me semble que le site n'existe plus
mais j'ai retrouvé l'archive plus vrai que nature ... :cool:

le code n'est pas verrouillé mais les explications et commentaires sont en nippon...
pas simple à interpréter et intervenir dans le code

Super !faut pas que je garde ça sur mon PC trop longtemps sinon ma productivité va chuter grave, y a pas ce sont encore les jeux les plus simples qui fonctionnent le mieux (tetris, sokoban, pacman, snakes...).

Mais c'est sur que les commentaires sont limités dans leur intérêt :
'@©F37@ªF38@¨F39@«F40
(surement !)
 

Statistiques des forums

Discussions
312 963
Messages
2 093 992
Membres
105 906
dernier inscrit
aifa