XL 2019 VBA EXCEL

losstocam · 2 Avril 2020

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 · 2 Avril 2020

patricktoulon à dit:
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 · 2 Avril 2020

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) --->>

VB:

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 · 3 Avril 2020

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

jmfmarques · 3 Avril 2020

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 · 3 Avril 2020

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

VB:

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 · 4 Avril 2020

bonjour Staple1600
fait nous le pour le X

patricktoulon · 4 Avril 2020

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

Staple1600 · 4 Avril 2020

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

VB:

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 · 4 Avril 2020

re
tiens basé sur ton code

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 · 4 Avril 2020

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

VB:

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

VB:

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 · 4 Avril 2020

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 · 4 Avril 2020

re
Ahgue Ah geu.....

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

VB:

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

XL 2019 VBA EXCEL

losstocam

XLDnaute Nouveau

VIARD

XLDnaute Impliqué

jmfmarques

XLDnaute Accro

losstocam

XLDnaute Nouveau

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

jmfmarques

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Discussions similaires