[HS] Petite énigme

Le
garnote
Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
LSteph
Le #4492891
Bonsoir Serge,

Le neuvième d'un Sudoku en quelque sorte!

;o)


Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge




LSteph
Le #4492851
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du
pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge




garnote
Le #4492831
Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge




LSteph
Le #4492821
...ce qui peut être assez surprenant ou amusant c'est les réponses
parfois obtenues lorsqu'on demande
combien voyez vous de carrés ?

@+

Stephane

Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge








garnote
Le #4492801
La prochaine énigme sera terrifiante !
Et tout ça n'est qu'un prétexte pour jouer au VBA.

Kon banwa, Oyasumi nasai
Serge


"garnote"
Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge








garnote
Le #4492751
Salut Stéphane,

En voici une moins bébé lala ;-)))

Placer tous les nombres entiers de 1 à 16 dans
une grille 4x4 de telle sorte que les sommes de
chaque ligne, chaque colonne et chaque diagonale
soient différentes. De plus ces dix sommes doivent
former une suite de nombres consécutifs.

Serais curieux de voir le code VBA qui pourrait
répondre à ça. Je vais très peut-être essayer ;-)

Serge




"LSteph"
...ce qui peut être assez surprenant ou amusant c'est les réponses parfois obtenues lorsqu'on demande
combien voyez vous de carrés ?

@+

Stephane

Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge









ChrisV
Le #4490381
Bonjour Stéphane,
salut Serge,
bonjour à tous,

Juste pour le fun...
Le plus amusant étant encore la recherche de la résolution par Excel... :-)
http://www.cijoint.fr/cij55688763712933.xls


ChrisV


"LSteph"
...ce qui peut être assez surprenant ou amusant c'est les réponses
parfois obtenues lorsqu'on demande
combien voyez vous de carrés ?

@+

Stephane

Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du
pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150,
150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, "
De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc,
hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc +
165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc +
165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc +
255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc +
255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc
/ 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc
/ 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3
* hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3
* hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge









LSteph
Le #4490301
Bonsoir Chris , Serge y tutti,

7 12 1 14
2 13 8 11
16 3 10 5
9 6 15 4


celui ci est particulier il vient d'un palais en Inde
On peut même additioner tous les carrés 2*2
les diagonales opposée (2 ; 2) et diagonales + coin (3;1)
et les 4 coins

Voir + ici
http://villemin.gerard.free.fr/Wwwgvmm/CarreMag/CMhistor.htm

Pour la prog en vba , en tout cas

Bon courage.

@+

lSteph


Salut Stéphane,

En voici une moins bébé lala ;-)))

Placer tous les nombres entiers de 1 à 16 dans
une grille 4x4 de telle sorte que les sommes de
chaque ligne, chaque colonne et chaque diagonale
soient différentes. De plus ces dix sommes doivent
former une suite de nombres consécutifs.

Serais curieux de voir le code VBA qui pourrait
répondre à ça. Je vais très peut-être essayer ;-)

Serge




"LSteph"
...ce qui peut être assez surprenant ou amusant c'est les réponses parfois obtenues lorsqu'on demande
combien voyez vous de carrés ?

@+

Stephane

Il faudrait modifier un tantinet les questions :

1.
À partir d'un seul carré sauriez-vous en obtenir
exactement neuf en traçant quatre segments
de droite à l'intérieur du carré initial.


2.
À partir d'un seul carré sauriez-vous en obtenir
exactement quatorze en traçant quatre segments
de droite à l'intérieur du carré initial.

Et je me demande quelle est la question la plus difficile ;-)

A+
Serge


"LSteph"
...

je vois donc une variante:
2 segments verticaux à une distance chacun de un tiers de côté du carré.
2 horizontaux idem , et nous voilà bien neuf carrés cette fois ci égaux
Sauf que...
sauriez vous en obtenir neuf... ,et bien cela fera dix avec celui du pourtour
+4 si l'on considère les 4 groues de 4 carrés situés à l'intérieur,
soit 14 carrés en tout.

@+

lSteph

Bonsoir,

À partir d'un seul carré sauriez-vous en obtenir
neuf en traçant quatre segments de droite à
l'intérieur du carré initial.
Si vous n'arrivez pas à resoudre cette énigme,
la macro suivante le fera pour vous ;-)

Sub De_Un_A_Neuf()
Sheets.Add
ActiveWindow.DisplayGridlines = False
With ActiveSheet
Set forme = .Shapes.AddShape(msoShapeRectangle, 50, 50, 150, 150)
forme.Name = "carré"
Set r = .Shapes("carré")
r.Line.ForeColor.SchemeColor = 10
DoEvents
MsgBox "Le premier carré.", vbInformation, " De un à neuf"
lc = r.Left
tc = r.Top
wc = r.Width
hc = r.Height
x1 = lc + wc / 2
y1 = tc
x2 = lc + wc / 2
y2 = tc + hc
Set s1 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc
y1 = tc + hc / 2
x2 = lc + wc
y2 = tc + hc / 2
Set s2 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + 3 * wc / 4
y1 = tc
x2 = lc + 3 * wc / 4
y2 = tc + hc / 2
Set s3 = .Shapes.AddLine(x1, y1, x2, y2)
x1 = lc + wc / 2
y1 = tc + hc / 4
x2 = lc + wc
y2 = tc + hc / 4
Set s4 = .Shapes.AddLine(x1, y1, x2, y2)
DoEvents
MsgBox "Quatre segments de droite en donnent neuf !" _
& vbNewLine & "Cliquez sur OK pour les voir.", vbExclamation, " De un à neuf"
Set un = .Shapes.AddShape(msoShapeRectangle, lc + 250, tc, wc, hc)
Set deux = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 165, wc / 2, hc / 2)
Set trois = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 165, wc / 2, hc / 2)
Set quatre = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 255, wc / 2, hc / 2)
Set cinq = .Shapes.AddShape(msoShapeRectangle, lc + 375, tc + 255, wc / 2, hc / 2)
Set six = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc, wc / 4, hc / 4)
Set sept = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc, wc / 4, hc / 4)
Set huit = .Shapes.AddShape(msoShapeRectangle, lc + 200, tc + 3 * hc / 4, wc / 4, hc / 4)
Set Neuf = .Shapes.AddShape(msoShapeRectangle, lc + 412, tc + 3 * hc / 4, wc / 4, hc / 4)
End With
End Sub

Serge











Publicité
Poster une réponse
Anonyme