OVH Cloud OVH Cloud

Petit problème de copie de code

1 réponse
Avatar
Gaspareau
Bonjour

Suite aux réponses de Michdenis plus tôt cette semaine et
à des recherches sur le site de Frederik Sigonneau, j'en suis
presque arrivé à ce que je désire.

Il me reste 2 problèmes

1- Je réussi à faire écrire le code dans ma feuille mais le problème c'Est
qu'il n'y a
pas de saut de ligne. Donc tout le code est écrit mais en une seule ligne

2- Le code se copie bien dans le fichier en cours. Je voudrais que ce
module soit
dans mon fichier Perso.xls et que le code soit copier dans la feuille et le
fichier en cours.

Quelqu'un peut me dire qu'est-ce qui me manque afin que ce code puisse
fonctionner?

Merci à quiconque peut m'aider


Voici le code

Sub Selection_lignecolonne3()
Dim Code$, NextLine&

Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)"
'*** Définition des variables ***
Code = Code & " h = ActiveCell.Height"
Code = Code & " w2 = ActiveCell.Width"
Code = Code & " t = ActiveCell.Top"
Code = Code & " w = ActiveCell.Left"
'Teste si les rectangles existent déjà.
'Code = Code & " On Error Resume Next"
'Code = Code & " ActiveSheet.Shapes("RectangleV").Delete
'Code = Code & " On Error Resume Next"
'Code = Code & " ActiveSheet.Shapes("RectangleH").Delete
'Code = Code & " On Error GoTo 0"

'Ajoute les rectangles

Code = Code & " ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, t, w,
h).Name = (RectangleV)"
Code = Code & " With ActiveSheet.Shapes(RectangleV)"
Code = Code & " .Fill.Visible = msoFalse"
Code = Code & " .Fill.Transparency = 0#"
Code = Code & " .Line.Weight = 3#"
Code = Code & " .Line.ForeColor.SchemeColor = 10"
Code = Code & " .ControlFormat.PrintObject = False"
Code = Code & " End With"

Code = Code & " ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, 0, w2,
t).Name = '""RectangleH" '
Code = Code & " With ActiveSheet.Shapes('""RectangleH" ')
Code = Code & " .Fill.Visible = msoFalse"
Code = Code & " .Fill.Transparency = 0#"
Code = Code & " .Line.Weight = 3#"
Code = Code & " .Line.ForeColor.SchemeColor = 10"
Code = Code & " .ControlFormat.PrintObject = False"
Code = Code & " End With"


Code = Code & " End Sub"


'Ecriture du code dans le module de la feuille (fs)
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With


End Sub

1 réponse

Avatar
FxM
Bonsoir,

1 -
Dans les lignes de code que j'ai pu voir sur le site de Frédéric, les
lignes se terminent par ' & vblf' (sans les ')

Code = Code & " t = ActiveCell.Top"
devient donc

Code = Code & " t = ActiveCell.Top" & vblf



2 -
Le code contient 'Ecriture du code dans le module de la feuille (fs)

Il est rare que Frédéric se trompe.
M'est avis que le code devrait faire ce qui est indiqué et qui est, à
priori, ce tu souhaites. ;o)

@+
FxM



Gaspareau wrote:
Bonjour

Suite aux réponses de Michdenis plus tôt cette semaine et
à des recherches sur le site de Frederik Sigonneau, j'en suis
presque arrivé à ce que je désire.

Il me reste 2 problèmes

1- Je réussi à faire écrire le code dans ma feuille mais le problème c'Est
qu'il n'y a
pas de saut de ligne. Donc tout le code est écrit mais en une seule ligne

2- Le code se copie bien dans le fichier en cours. Je voudrais que ce
module soit
dans mon fichier Perso.xls et que le code soit copier dans la feuille et le
fichier en cours.

Quelqu'un peut me dire qu'est-ce qui me manque afin que ce code puisse
fonctionner?

Merci à quiconque peut m'aider


Voici le code

Sub Selection_lignecolonne3()
Dim Code$, NextLine&

Code = "Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)"
'*** Définition des variables ***
Code = Code & " h = ActiveCell.Height"
Code = Code & " w2 = ActiveCell.Width"
Code = Code & " t = ActiveCell.Top"
Code = Code & " w = ActiveCell.Left"
'Teste si les rectangles existent déjà.
'Code = Code & " On Error Resume Next"
'Code = Code & " ActiveSheet.Shapes("RectangleV").Delete
'Code = Code & " On Error Resume Next"
'Code = Code & " ActiveSheet.Shapes("RectangleH").Delete
'Code = Code & " On Error GoTo 0"

'Ajoute les rectangles

Code = Code & " ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, t, w,
h).Name = (RectangleV)"
Code = Code & " With ActiveSheet.Shapes(RectangleV)"
Code = Code & " .Fill.Visible = msoFalse"
Code = Code & " .Fill.Transparency = 0#"
Code = Code & " .Line.Weight = 3#"
Code = Code & " .Line.ForeColor.SchemeColor = 10"
Code = Code & " .ControlFormat.PrintObject = False"
Code = Code & " End With"

Code = Code & " ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, 0, w2,
t).Name = '""RectangleH" '
Code = Code & " With ActiveSheet.Shapes('""RectangleH" ')
Code = Code & " .Fill.Visible = msoFalse"
Code = Code & " .Fill.Transparency = 0#"
Code = Code & " .Line.Weight = 3#"
Code = Code & " .Line.ForeColor.SchemeColor = 10"
Code = Code & " .ControlFormat.PrintObject = False"
Code = Code & " End With"


Code = Code & " End Sub"


'Ecriture du code dans le module de la feuille (fs)
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
NextLine = .CountOfLines + 1
.InsertLines NextLine, Code
End With


End Sub