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]

Bonjour à toutes et tous

Il y a longtemps pour m'occuper, j'ai une petite fonction,
pour réaliser des cellules carrées,

à tester

A+ Jean-Paul

Function DimensionCellule(ByVal x As Long, ByVal y As Long)
'Auteur : JPV
Dim h%, Point&, rng&, rng1&
Dim hauteur&, largeur&, rapport&

Cells(x, y).Select
h = 8 'dimension en millimètre
Point = h / 0.35
With Selection
    .RowHeight = Point
End With
'------ asservissement pour avoir les cellules carrées ------
Do
    rng = ActiveCell.Width
    rng1 = ActiveCell.Height
    hauteur = ActiveCell.RowHeight
    largeur = ActiveCell.ColumnWidth
    rapport = rng / rng1
    With Selection
        .RowHeight = hauteur
        .ColumnWidth = largeur / rapport
    End With
Loop Until rapport = 1
End Function
'===============================
Sub CelluleCarré() 'Manip Test
Dim i%

Sheets("Feuil1").Select
Application.ScreenUpdating = False
For i = 1 To 9
    DimensionCellule i, i
Next i
Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
'================================

 

[jmfmarques]

Bonjour Robert
Ouais, n'est-il pas ?
Et de deux choses l'une, dans ce cas :
- soit le prof n'a pas pensé à cette "subtilité" (et il sera bien embêté ...)
- soit il y a bel et bien pensé et :
---- leur a enseigné une certaine différence
---- attend que ses élèves montrent qu'il l'ont écouté.

Car la "chose" est tout-à-fait réalisable par macro.

 

[jmfmarques]

Bonjour VIARD.
Il y a dieu merci plus simple (et probablement ce dont le prof leur a parlé).
Ceci étant, les "carrés" ne mériteront ce qualificatif que par référence au même nombre de pixels pour les 2 dimensions et ne le mériteront pas toujours graphiquement parlant (largeurs en unités métriques). Mais je doute que le prof soit allé jusqu'à cet aspect-là qui, lui, demande des connaissances autres que celles de VBA.

 

[Staple1600]

Re, Bonjour VIARD

Issue de mon armoire VBA (avec la poussière en prime )

Sub NeufCellulesCarrées_et_plus_Follow_The_Line()
Set r = Range("A1:I9")
r.RowHeight = r.Width / r.Columns.Count: r.ColumnWidth = (((r.Width / r.Columns.Count) / 0.75 - 5) / 7)
r.ColumnWidth = (((r.Height / r.Rows.Count) / 0.75 - 5) / 7): r.RowHeight = r.Height / r.Rows.Count
ActiveWindow.Zoom = 40
End Sub

 

[VIARD]

Bonjour jmfmarques et à tous

Tout à fait, c'est la réflexion que je m'étais faite à l'époque.
essentiellement dû au rapport hauteur, largeur en pixel qui n'est pas la même.
ceci dit il y a surement plus simple.
en modifiant la taille du carré le résultat n'est pas trop mauvais.

A+

 

[VIARD]

Salut l’agrafe

je n'avais pas vu ton message

 

[patricktoulon]

re
perso
je pige pas le soucis mais vraiment pas moi pour faire un carré du moment que l'on sait que
la propriété width et height n'est qu'en lecture seule
(je dis bien width et height et non columnwidth et rowheight)
mais que l'on peut s'en servir pour calculer
parti de la

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

j'ai tout bon prof??

 

[Staple1600]

Re, Bonjour VIARD

Avec tout cela, on a perdu le demandeur dans l'histoire

Et je sais toujours pas si c'est au collège, au lycée ou ailleurs qu'il y a ce genre d'exercice.

>•patricktoulon
Je viens de mettre ton code dans mon armoire
(mais j'ai retiré la poussière avant
cf message#19)

 

[jmfmarques]

Cela ne règlera pas l'affaire des dimensions graphiques, mais au moins celle des dimensions en unité d'affichage (pixels ou points, donc) :
Il suffit de garder présente à l'esprit la différence entre les unités des largeurs de colonne (columnwidth) et celles des hauteurs de ligne (rowheight). Les premières sont déterminées en dimension/police "normale" , les sec ondes, en points.

 

[Robert]

Re,

Pour losstocam, qui visiblement se fout bien de nos délires et pour tous les autres chipoteurs :

Sub exo2()
Dim PL As Range
Dim LI As Byte
Dim COL As Byte

Set PL = Range("A1:I9")
PL.Columns.ColumnWidth = 6.43
PL.Rows.RowHeight = 37.5
PL.Interior.ColorIndex = xlNone
For LI = 1 To 9
    For COL = 1 To 9
        If LI = COL Or LI = 10 - COL Then
            Cells(LI, COL).Interior.ColorIndex = 3
        End If
    Next COL
Next LI
For LI = 1 To 9
    For COL = 2 To 8
        If COL >= LI + 1 And COL <= 9 - LI Then
            Cells(LI, COL).Interior.ColorIndex = 5
        End If
    Next COL
Next LI
End Sub

 

[patricktoulon]

@Staple1600 je n'avais pas vu ton #19 c'est pas mal aussi
perso dans ce genre de travaux de dimensionnement je n'aime pas trop les données numérique en dur dans le code mais ça fonctionne

 

[patricktoulon]

Re


En attendant le retour du demandeur

Sub carré_avec_des_endives() ' effet collatéral du Grand Confinement du 2020
With Cells(1).Resize(9, 9): .ColumnWidth = .ColumnWidth / (.Item(1).Width / .Item(1).Height): End With
End Sub

tu chipote Staple1600 bon d'accords je met ca sur le compte du confinement

 

[patricktoulon]

re
du coup je crois que l'on a répondu à jmfmarques

 

[Robert]

Re,

Bon fuyons, commencent tous à (censuré) grave...

 

[jmfmarques]

Bon ...
Exemple tout bête et parfaitement compréhensible --->>

With Range("A1:I9")
  .ColumnWidth = 5  ' -->> choisir la taille que l'on veut
  .RowHeight = Range("A1").Width
End With