XL 2019 VBA EXCEL

[losstocam]

Bonjour j'ai cet exercice a faire mais je n'y arrive pas quelqu'un aurait la solution ?

Créer une macro nommée « exo2 » affectée à un bouton qui réalisera :

• Ajustez la dimension des cellules 9×9 carrées.
• Colorez les deux diagonales des cellules 9×9 avec une couleur en utilisant deux boucles « for … next » et le jugement « if then … end if ».
• Colorez un quart quelconque des cellules 9×9 non diagonales avec une autre couleur en utilisant deux boucles « for … next » et le jugement « if then … end if ».

 

[VIARD]

Sub dimrangecarré() Range("A1:i9").ColumnWidth = Range("A1:i9").ColumnWidth / ( Cells(1).Width/ Cells(1).Height) End Sub

D'accord Patrick

seulement avec ma fonction je peux donner une taille quelconque.
la valeur du point

 

[jmfmarques]

Allez, va
Nous apprenons dans l'autre discussion (table de multiplication) qu'il s'agit d'un exercice niveau bac pro
Bac "pro" ou non, nous allons le ramener à celui bien plus modeste de l'arithmétique

Voilà qui fait tout (mise au carré, diagonales en rouge et une portion en bleu) --->>

Set P = Range("A1:I9")
With P
  .ColumnWidth = 3: .RowHeight = Range("A1").Width
  For k = 1 To 9
    P(k, k).Interior.Color = RGB(255, 0, 0)
    P(k, 10 - k).Interior.Color = RGB(255, 0, 0)
    If k > 5 Then
       P(k, 10 - k + 1).Resize(10 - k, 1).Interior.Color = RGB(0, 0, 255)
       P(k, k - 1).Resize(10 - k, 1).Interior.Color = RGB(0, 0, 255)
    End If
  Next
End With

 

[losstocam]

C'est bon j'ai réussi à comprendre en partie ou j'avais faux. Merci beaucoup de votre aide à bientôt

 

[jmfmarques]

C'est bon j'ai réussi à comprendre en partie ou j'avais faux.

Ce devait alors être enfoui à 1000 lieux sous terre, hein ... car nous n'avons jusqu'à présent pas vu le moindre petit bout de code au moins tenté par tes soins.
N 'oublie maintenant surtout pas de renseigner ton prof sur l'origine de la solution que tu vas lui présenter

 

[patricktoulon]

Bonjour
les roues du camion tournent et tournent .. tournent et tournent ...
ma belle a mère a un balai dans le .. dans le ... dans le ...
il fallait des if else.. ben t'es servi
@jmfmarques ne m'en veux pas j'ai repris la base de ton code

Option Explicit
Sub test()
Dim cycle, I&
cycle = Array("haut", "droite", "bas", "gauche", "droite", "haut", "bas", "haut", "droite", "bas", "gauche")
For I = 0 To UBound(cycle)
Application.Wait Now + 0.00001
les_roue_du_camion_tourne_et_tourne CStr(cycle(I))
Next
Range("A1:I9").Clear
End Sub




Sub les_roue_du_camion_tourne_et_tourne(Optional triangle As String = "haut")
    Dim p As Range, cel1 As Range, cel2 As Range, K&
    Set p = Range("A1:I9")
    With p
        .Interior.Color = xlNone
        .ColumnWidth = 3: .RowHeight = Range("A1").Width
        For K = 1 To 9
            Set cel1 = p(K, K)
            Set cel2 = p(K, 10 - K)
            cel1.Interior.Color = RGB(255, 0, 0)
            cel2.Interior.Color = RGB(255, 0, 0)

            If triangle = "bas" Then
                If K > 5 Then
                    cel2.Offset(, 1).Resize(10 - K, 1).Interior.Color = RGB(0, 0, 255)
                    cel1.Offset(, -1).Resize(10 - K, 1).Interior.Color = RGB(0, 0, 255)
                End If

            ElseIf triangle = "haut" Then
                If K < 5 Then cel1.Offset(, 1).Resize(1, 9 - (K * 2)).Interior.Color = RGB(0, 0, 255)

            ElseIf triangle = "gauche" Then
                If K < 5 Then cel1.Offset(1).Resize(9 - (K * 2)).Interior.Color = RGB(0, 0, 255)

            ElseIf triangle = "droite" Then
                If cel1.Column > 5 And cel1.Column < 9 Then cel1.Offset(, 1).Resize(, 9 - K).Interior.Color = RGB(0, 0, 255)

                If cel2.Column >= 5 And cel2.Column < 9 Then cel2.Offset(, 1).Resize(, 10 - cel2.Column - 1).Interior.Color = RGB(0, 0, 255)

            End If

        
    Next
End With
End Sub

yLa Kraké le toulonnais

 

[patricktoulon]

bonjour Staple1600
fait nous le pour le X

 

[patricktoulon]

re
ca fait rien c'est toujours bon de voir d'autre approches

 

[Staple1600]

Re

Je suis désolé pour ce qui va suivre...
mais mon pilulier est vide et "l'infirmier de minuit distribue le cyan..."

NB: (sur une feuille vierge)
•Lancer la macro une 1ère fois puis cliquer sur OK
•Lancer la macro une 2ième fois, saisir 1 puis cliquer sur OK

Sub Over_Confined_Am_I()
En_Rouge_Et_Bleu = InputBox("Vrai ou faux?", "Jeanne Mas sort de cette Sub", "9-9=0")
X_Or_Not_X Evaluate(En_Rouge_Et_Bleu) = True
End Sub
Private Sub X_Or_Not_X(Optional Cross As Boolean = True)
Dim R As Range, Tb(1 To 9, 1 To 9), i%, j%: Set R = Range("A1:I9")
For i = LBound(Tb, 1) To UBound(Tb, 1): For j = LBound(Tb, 2) To UBound(Tb, 2): Tb(i, j) = IIf(Cross, Int((i + j) / 10), (i + j) / 10) Mod 82: Next j: Next i
With R
    .ColumnWidth = 4: .RowHeight = .Item(1).Width: .Value = Tb
    .FormatConditions.Add Type:=xlExpression, Formula1:="=ou(A1=0;A1=2)"
    With .FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
    .FormatConditions.Add xlCellValue, xlEqual, Formula1:="=1"
    With .FormatConditions(2): .Interior.Color = vbBlue: .Font.Color = vbBlue: End With
End With
End Sub

 

[patricktoulon]

re
tiens basé sur ton code

Spoiler: not cross_X

Sub Not_Cross_X()
Dim R As Range, Tb
Set R = Range("A1:I9"): R.Clear: R.Value = -1: Tb = R.Value
For i = LBound(Tb, 1) To UBound(Tb, 1): Tb(i, i) = 0: Tb(i, 10 - i) = Tb(i, i): Next i
With R
.ColumnWidth = 4: .RowHeight = .Item(1).Width: .Value = Tb
.FormatConditions.Add xlCellValue, xlEqual, Formula1:="=0"
With .FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
.FormatConditions.Add xlCellValue, xlEqual, Formula1:="=-1"
With .FormatConditions(2): .Interior.Color = vbBlue: .Font.Color = vbBlue: End With
End With
End Sub

 

[patricktoulon]

re
Allez on va pas s'arrêter en si bon chemin
@Staple1600 toujours basé sur ton principe + le mien qui est la position symétrique des rouge +maintenant les 4 triangles

Sub testxxxx()
    Dim R As Range, lig%, col%, tb
    Set R = Range("A1:I9"): R.Clear:
    tb = (R.Value)
    For lig = 1 To UBound(tb): For col = 1 To UBound(tb, 2)
            'croix
            If lig = col Or 10 - col = lig Then tb(lig, col) = "X"
            'triangle haut et bas
            If col > lig And lig < 5 And lig < 10 - col Then tb(lig, col) = "H": tb(10 - lig, col) = "B"
            'triangle gauche et doite
            If col < lig And col < 10 - lig Then tb(lig, col) = "G": tb(lig, 10 - col) = "D"
        Next col, lig

        With R
            .ColumnWidth = 4: .RowHeight = .Item(1).Width: .Value = tb
            .FormatConditions.Add xlCellValue, xlEqual, Formula1:="X"
            With .FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
            .FormatConditions.Add xlCellValue, xlEqual, Formula1:="H"
            With .FormatConditions(2): .Interior.Color = vbGreen: .Font.Color = vbGreen: End With
            .FormatConditions.Add xlCellValue, xlEqual, Formula1:="G"
            With .FormatConditions(3): .Interior.Color = vbMagenta: .Font.Color = vbMagenta: End With
            .FormatConditions.Add xlCellValue, xlEqual, Formula1:="D"
            With .FormatConditions(4): .Interior.Color = vbCyan: .Font.Color = vbCyan: End With
            .FormatConditions.Add xlCellValue, xlEqual, Formula1:="B"
            With .FormatConditions(5): .Interior.Color = vbYellow: .Font.Color = vbYellow: End With

        End With
End Sub

il est basé sur un de mes premiers essais directe sur cells ci dessous

Sub test()
    Dim plage As Range, lig%, col%
    Application.ScreenUpdating = False
    Set plage = Range("A1:I9"): plage.Clear:
    For lig = 1 To 9: For col = 1 To 9
            'croix
            If lig = col Or 10 - col = lig Then Cells(lig, col).Interior.Color = vbRed
            'triangle haut et bas
            If col > lig And lig < 5 And lig < 10 - col Then
                Cells(lig, col).Interior.Color = vbGreen: Cells(10 - lig, col).Interior.Color = vbYellow
            End If
            'triangle gauche et doite
            If col < lig And col < 10 - lig Then
                Cells(lig, col).Interior.Color = vbMagenta: Cells(lig, 10 - col).Interior.Color = vbCyan
            End If

        Next col, lig
End Sub

 

[jmfmarques]

Coucou à tous
Digresser pour digresser, amusez_vous à aller jusqu'à un caléidoscope animé et mutant constitué d'une nombre important de très petites cellules carrées

 

[patricktoulon]

re
Ahgue Ah geu.....

Staple1600 pour te faire plaisir je t'ajoute l'autre diagonale

Sub Blue_Line2()
Dim R As Range: Cells.Delete: Set R = [A1:I9]: R.FormulaLocal = "=OU(LIGNE()=COLONNE();COLONNE()=10-LIGNE())": R.ColumnWidth = 4: R.RowHeight = [a1].Width
R.FormatConditions.Add 1, 3, "=VRAI": R.FormatConditions.Add 1, 5, "=0"
With R.FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
With R.FormatConditions(2): .Interior.Color = vbBlue: .Font.Color = vbBlue: End With
End Sub

purée le confinement nous rend completement zinzin
réduit a tracer des diagonales