Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel [HS] Petite énigme

[HS] Petite énigme

8 réponses
Avatar
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
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
LSteph
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




Avatar
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




Avatar
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" a écrit dans le message de news:
...

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




Avatar
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" a écrit dans le message de news:
...

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








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

Kon banwa, Oyasumi nasai
Serge


"garnote" a écrit dans le message de news:
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" a écrit dans le message de news:
...

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








Avatar
garnote
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" a écrit dans le message de news:
...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" a écrit dans le message de news:
...

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









Avatar
ChrisV
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" a écrit dans le message de news:

...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" a écrit dans le message de news:

...

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









Avatar
LSteph
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" a écrit dans le message de news:
...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" a écrit dans le message de news:
...

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