Entourer la colonne et la ligne de la cellule active

Bonjour,

J'aimerais créer un cadre autour de la colonne et de la ligne de la cellule active.

Dans l'idéal, j'aimerais que le cadre sélectionne uniquement les cellules dans la plage G2:AS40. Si c'est trop complexe, c'est pas très grave.

Actuellement j'utilise une forme géométrique pour répondre à mes besoins...

Mon tableau me sert pour le travail afin de dimensionner des réseaux de ventilation.

J'ai trouvé un bout de script qui entoure la cellule active sur laquelle je pense faut partir.

[quote][Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

h = ActiveCell.Height

w2 = ActiveCell.Width

t = ActiveCell.Top

w = ActiveCell.Left

On Error Resume Next

ActiveSheet.Shapes("HiliteSelect").Delete

On Error GoTo 0

ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, t, w2, h).Name = "HiliteSelect"

With ActiveSheet.Shapes("HiliteSelect")

.Fill.Visible = msoFalse

.Fill.Transparency = 0#

.Line.Weight = 3#

.Line.ForeColor.SchemeColor = 10

.ControlFormat.PrintObject = False

End With

End Sub

[/quote]

Je vous joint mon tableau.

Merci pour votre aide.

Bonjour,

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next
    ActiveSheet.Shapes("HiliteSelect").Delete
On Error GoTo 0

    If Intersect(Target, Range("G2:AS40")) Is Nothing Then Exit Sub
    With ActiveCell
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "HiliteSelect"
    End With
    With ActiveSheet.Shapes("HiliteSelect")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .ControlFormat.PrintObject = False
    End With
End Sub

Pour une sélection multiple

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next
    ActiveSheet.Shapes("HiliteSelect").Delete
On Error GoTo 0

    If Intersect(Target, Range("G2:AS40")) Is Nothing Then Exit Sub
    Set plage = Intersect(Target, Range("G2:AS40"))
    With plage
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "HiliteSelect"
    End With
    With ActiveSheet.Shapes("HiliteSelect")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .ControlFormat.PrintObject = False
    End With
End Sub

Bonjour Steelson, merci pour tes réponses.

Malheureusement ce n'est pas ce que j'imaginais.

Prenons le fichier que t'as nommé "encadre selection" et on va mettre comme valeur un débit de 450 m3/h et une vitesse de 3 m/s.

De ce fait et d'après les calculs de ma feuille, je vais choisir une gaine en 300x150ht (dont le débit max sera 486 m3/h) car elle n'est pas dans la zone rouge et est la plus plate possible.

L'idée serait que si j'ai la cellule K3 d'active, j'aurais un premier cadre faisant K1:K40 et un deuxième faisant F3:AS3.

Autre exemple : débit à 1675 m3/h et vitesse à 3 m/s, ma gaine la plus plate sera 550x300ht, donc si j'ai d'active la cellule P6, je veux que les cadres fassent P1:P40 et F6:AS6.

D'ailleurs, en tapant mes exemples, je me rend compte qu'on pourrait étudier une piste : reprendre la lettre et le chiffre de la cellule active et les attribuer aux cadres.

Si j'ai d'active "U15", je sépare le "U" du "15"

Mon premier cadre doit être sur la même colonne que ma cellule active et entre les lignes 1 et 40.

Mon deuxième cadre doit être sur la même ligne que ma cellule active et entre les colonnes F et et AS.

ludwig59 a écrit :

L'idée serait que si j'ai la cellule K3 d'active, j'aurais un premier cadre faisant K1:K40 et un deuxième faisant F3:AS3.

ok, je m'étais posé la question ... comme tu vais mis

le cadre sélectionne uniquement les cellules dans la plage G2:AS40

Je te fais cela ...

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next
    ActiveSheet.Shapes("HiliteSelectH").Delete
    ActiveSheet.Shapes("HiliteSelectV").Delete
On Error GoTo 0
    If Intersect(Target, Range("G2:AS40")) Is Nothing Then Exit Sub

    Set domaine = Range("F1:AS40")

    Set plage = Intersect(domaine, Rows(Target.Row))
    With plage
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "HiliteSelectH"
    End With
    With ActiveSheet.Shapes("HiliteSelectH")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .ControlFormat.PrintObject = False
    End With

    Set plage = Intersect(domaine, Columns(Target.Column))
    With plage
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "HiliteSelectV"
    End With
    With ActiveSheet.Shapes("HiliteSelectV")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .ControlFormat.PrintObject = False
    End With

End Sub

Au passage, en A14, tu peux écrire

=SIERREUR(INDEX(A44:A69;EQUIV(A4;B44:B69;1)+1);A44)

Bonjour ludwig59

si cela te convient, merci de clôturer le sujet

Salut,

Désolé pour la réponse tardive. Oui cela me convient parfaitement !! Un grand merci à toi !!!