XL 2010 Excel VBA

[Konte94]

Salut tout le monde, svp qui peut m'aider à écrire un programme vba qui me permettra d'obtenir un carré magique d'ordre impair avec l'algorithmique de Bachet:

Indication : le nombre 1 doit se placer tout juste en dessous de la cellule centrale.
A chaque fois on descend d'une cellule puis on décale d'une à droite et on met le chiffre consécutif, si on trouve un chiffre là-bas on remonte et on descend de deux cellules et on met le chiffre consécutif ainsi de suite

Exemple
4 9 2
3 5 7
8 1 6

La Somme des lignes, des colonnes et des diagonales est égale.

 

[Dranreb]

Pas avant d'avoir défini les noms "LeCarréMagique" et "Coté" à l'aides des commandes Excel faites pour ça et montrées dans l'image poste précédent.

 

[Konte94]

Pas avant d'avoir défini les noms "LeCarréMagique" et "Coté" à l'aides des commandes Excel faites pour ça et montrées dans l'image poste précédent.

Je dois aller dans formule renommer la fonction ensuite exécuter ?

 

[Dranreb]

Ce n'est pas la fonction qu'il faut renommer ce sont les plages sur lesquelles elle doit s'appyuer qu'il faut définir par ces noms. "Coté" pour la cellule qui contiendra le nombre de valeurs souhaitées par coté et "LeCarréMagique" pour la plage qui devra recueillir le résultat.

 

[Konte94]

Sa ne peut pas se faire dans le programme ?

 

[Dranreb]

Bien sûr qu'on pourrait figer les emplacements dans la macro mais comme vous n'avez jamais dit où vous voulez tout ça ni jamais joint de classeur pour qu'on puisse le voir …
Le nom "LeCarréMagique" sera toutefois crée par la macro elle même quand même.

 

[Konte94]

Bien sûr qu'on pourrait figer les emplacements dans la macro mais comme vous n'avez jamais dit où vous voulez tout ça ni jamais joint de classeur pour qu'on puisse le voir …
Le nom "LeCarréMagique" sera toutefois crée par la macro elle même quand même.

Si c'était possible d'utiliser les InputBox. Si on exécute sa nous demande automatiquement la taille souhaité. Je pense que ce sera mieux.

 

[Dranreb]

Ça ne dit toujours pas où vous voulez le résultat.

 

[Konte94]

Ça ne dit toujours pas où vous voulez le résultat.

Je veux que tt soit dans le programme, si j'exécute sa me demande la taille, je le met et automatiquement sa me donne le carré magique

 

[Dranreb]

Oui mais ça vous le donne où ?
Vous ne le voulez pas dans des cellules ?
Remarque: on pourrait le mettre à partir de la cellule sélectionnée si vous voulez …

 

[Konte94]

Bien sûr mais je préfère quand tout est figé dans le programme

 

[Dranreb]

On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous le voulez.

 

[Konte94]

On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous pren

On le produit à partir de la cellule sélectionnée, alors ? Sinon dites moi l'adresse de la cellule où vous le voulez.

Choisissez une cellule

 

[Dranreb]

Option Explicit
Sub ProduireCarréMagique()
   Dim Coté As Long, RngCM As Range
   On Error Resume Next
   Coté = InputBox("Combien de nombres par coté ?")
   If Err Then Exit Sub
   Set RngCM = ActiveSheet.[LeCarréMagique]
   If Err Then Set RngCM = Selection
   On Error GoTo 0
   RngCM.ClearContents
   Set RngCM = RngCM.Resize(Coté, Coté)
   RngCM.Value = CarréMagique(Coté)
   RngCM.Worksheet.Names.Add "LeCarréMagique", RngCM
   End Sub
Function CarréMagique(ByVal Coté As Long) As Variant()
   CalculCarréMagique CarréMagique, Coté
   End Function
Sub CalculCarréMagique(T(), ByVal Coté As Long)
   Dim M As Long, Y As Long, X As Long, L As Long, C As Long, N As Long
   ReDim T(1 To Coté, 1 To Coté)
   M = Coté \ 2
   For Y = -M To M: For X = -M To M
      N = N + 1
      L = X + Y + M + Coté
      C = X - Y + M + Coté
      T(L Mod Coté + 1, C Mod Coté + 1) = N
      Next X, Y
   End Sub

 

[Konte94]

Option Explicit
Sub ProduireCarréMagique()
   Dim Coté As Long, RngCM As Range
   On Error Resume Next
   Coté = InputBox("Combien de nombres par coté ?")
   If Err Then Exit Sub
   Set RngCM = ActiveSheet.[LeCarréMagique]
   If Err Then Set RngCM = Selection
   On Error GoTo 0
   RngCM.ClearContents
   Set RngCM = RngCM.Resize(Coté, Coté)
   RngCM.Value = CarréMagique(Coté)
   RngCM.Worksheet.Names.Add "LeCarréMagique", RngCM
   End Sub
Function CarréMagique(ByVal Coté As Long) As Variant()
   CalculCarréMagique CarréMagique, Coté
   End Function
Sub CalculCarréMagique(T(), ByVal Coté As Long)
   Dim M As Long, Y As Long, X As Long, L As Long, C As Long, N As Long
   ReDim T(1 To Coté, 1 To Coté)
   M = Coté \ 2
   For Y = -M To M: For X = -M To M
      N = N + 1
      L = X + Y + M + Coté
      C = X - Y + M + Coté
      T(L Mod Coté + 1, C Mod Coté + 1) = N
      Next X, Y
   End Sub

Je parle de sa mais le côté doit être Supérieur à 2 et impair. Je veux si c'est pair que sa n'affiche rien

 

[Dranreb]

Mettez If Coté Mod 2 = 0 Then Exit Sub derrière RngCM.ClearContents