changement de propriété de la zone de texte

[Norah]

Bonjour!
Jai un petit souci. Lorsque j'execute la macro, j'ai un message d'erreur qui me dit "méthode ou propriete non gérée par cet objet". Je ne vois ou se trouve mon erreur alors si quelqu'un veut bien m'aider .....

Merci d'avance

voici la première partie de ma macro:

Sub Boucle_macro()

'Déclaration variable adresse des cellules
Dim Adresse_cellule_Pk_deb As String
Dim Adresse_cellule_Pk_fin As String
Dim Adresse_cellule_date_deb As String
Dim Adresse_cellule_date_fin As String
Dim Adresse_cellule_poste As String
Dim Adresse_cellule_tache As String
' Déclaration variables des coordonnées de début et de fin du connecteur
Dim X_deb As Long
Dim Y_deb As Long
Dim X_fin As Long
Dim Y_fin As Long
' Déclaration variables des coordonnées d'insertion du connecteur
Dim X_texte As Double
Dim Y_texte As Double
' Déclaration variable des coordonnées du milieu du connecteur
Dim X_milieu As Double
Dim Y_milieu As Double
' Déclaration variable coordonnées d'insertion du connecteur rectangle
Dim X_rectangle As Double
Dim Y_rectangle As Double
' Déclaration variable coordonnées centre zone de texte
Dim X_centre As Double
Dim Y_centre As Double
' Déclaration variable coordonnées centre rectangle
Dim X_centreR As Double
Dim Y_centreR As Double
' Déclaration variable du delta X et delta Y
Dim DeltaX As Long
Dim DeltaY As Long
' Déclaration variable longueur diff
Dim dx As Double
Dim dy As Double
' Déclaration variables de la longueur du connecteur
Dim Long_connecteur As Double
' Déclaration variable de l'angle formé par l'axe des abscisses et le connecteur
Dim Angle As Double
' Déclaration variable de l'angle final
Dim Angle_fin As Double
' Déclaration variable rapport entre les deltas
Dim Div As Double
' Déclaration variabble de l'objet
Dim Texte As Object
' Déclaration variable "tache"
Dim Tache As String
' Déclaration variable Poste
Dim vPoste As String
' Déclaration variable connecteur rectangle
Dim Rectangle As Object
' Déclaration variable de cellule
Dim vCellule As Variant

'initialisation de la boucle
i = 1


Worksheets("Feuil1").Activate
Worksheets("Feuil1").Range("B4").Select
vCellule = ActiveCell.Value

 

[Norah]

Re : changement de propriété de la zone de texte

La suite....

Do


i = i + 1

Adresse_vCellule = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_Pk_deb = ActiveCell.Offset(i - 2, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_Pk_fin = ActiveCell.Offset(i - 2, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_date_deb = ActiveCell.Offset(i - 2, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_date_fin = ActiveCell.Offset(i - 2, 6).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_poste = ActiveCell.Offset(i - 2, 7).Address(RowAbsolute:=False, ColumnAbsolute:=False)
Adresse_cellule_tache = ActiveCell.Offset(i - 1, 0).Address(RowAbsolute:=False, ColumnAbsolute:=False)
vCellule = Range(Adresse_cellule_tache).Value

Set myDocument = Worksheets("Feuil6")

' Formule de calcul des coordonnées début et fin du connecteur par rapport au valeur _
des PK et du système de coordonnée de la feuille excel
X_deb = 1000 + (Worksheets("Feuil1").Range(Adresse_cellule_date_deb).Value - 1) * 10
Y_deb = 1000 + (5725 - Worksheets("Feuil1").Range(Adresse_cellule_Pk_deb).Value) * 10 / 25
X_fin = 1000 + (Worksheets("feuil1").Range(Adresse_cellule_date_fin).Value - 1) * 10
Y_fin = 1000 + (5725 - (Worksheets("Feuil1").Range(Adresse_cellule_Pk_fin).Value - 25)) * 10 / 25
' Formule de calcul des coordonnées du milieu
X_milieu = (X_deb + X_fin) / 2
Y_milieu = (Y_deb + Y_fin) / 2
' Formule de calcul des deltas
DeltaX = (X_fin - X_deb)
DeltaY = (Y_fin - Y_deb)
' Formule du calcul du rapport entre delta X et delta Y
Div = DeltaY / DeltaX
' Formule de calcul de l'angle formé par l'axe des abscisses et l'axe des ordonnés
Angle = Atn(Abs(Div)) * 180 / 3.14159265358979
' Formule de calcul de la longueur du connecteur
Long_connecteur = Sqr((DeltaX * DeltaX) + (DeltaY * DeltaY))
' Affectation de la variable "tache"
Tache = Worksheets("Feuil1").Range(Adresse_vCellule).Value
' Affectation de la variable "Poste"
vPoste = Worksheets("Feuil1").Range(Adresse_cellule_poste).Value

' Procédure de calcul de l'angle de fin et de la coordonnée d'insertion de la zone de texte
If DeltaY > 0 Then
Angle_fin = Angle
X_centre = X_milieu
Y_centre = Y_milieu
X_centreR = X_milieu + 6 * Sin(Abs(Angle_fin) * 3.14159265358979 / 180)
Y_centreR = Y_milieu - 6 * Cos(Abs(Angle_fin) * 3.14159265358979 / 180)
dx = Long_connecteur / 2 - X_centre + X_deb
dy = Y_centre - Y_deb - 30
X_texte = X_deb - dx
Y_texte = Y_deb + dy
X_rectangle = X_centreR - Long_connecteur / 2
Y_rectangle = Y_centreR - 5

Else
Angle_fin = -Angle
X_centre = X_milieu
Y_centre = Y_milieu
X_centreR = X_milieu + 6 * Sin(Abs(Angle_fin) * 3.14159265358979 / 180)
Y_centreR = Y_milieu + 6 * Cos(Abs(Angle_fin) * 3.14159265358979 / 180)
dx = X_centre - X_deb - Long_connecteur / 2
dy = 30 + Y_deb - Y_centre
X_texte = X_deb + dx
Y_texte = Y_deb - dy
X_rectangle = X_centreR - Long_connecteur / 2
Y_rectangle = Y_centreR - 5
End If

If vPoste = "J" _
Then
' Procédure de dessin du connecteur
With myDocument.Shapes.AddLine(X_deb, Y_deb, X_fin, Y_fin).Line
.ForeColor.RGB = RGB(18, 228, 28)
.Weight = 3
End With

' Procédure d'insertion d'une zone de texte
Set Texte = myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
X_texte, Y_texte, Long_connecteur, 60)
Texte.Rotation = Angle_fin
Texte.TextFrame.Characters.Text = Tache
Texte.TextFrame.MarginTop = 10

Texte.Select
With Selection.Characters.Font
.Name = "Time New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Fill.Solid
.ShapeRange.Fill.Transparency = 1#
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSingle
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Transparency = 1#
.ShapeRange.Line.Visible = msoFalse
End With

 

[Norah]

Re : changement de propriété de la zone de texte

et voila la fin.... (enfin)

Else
If vPoste = "N" _
Then
' Procédure de dessin du connecteur rectangle
Set Rectangle = myDocument.Shapes.AddShape(msoShapeRectangle, X_rectangle, Y_rectangle, Long_connecteur, 10)
Rectangle.Rotation = Angle_fin
With Rectangle.Fill
.ForeColor.RGB = RGB(18, 228, 28)
.BackColor.RGB = RGB(170, 170, 170)
.Patterned (msoPatternLargeCheckerBoard)
End With

Rectangle.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSingle
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Transparency = 1#
.ShapeRange.Line.Visible = msoFalse
End With

' Procédure d'insertion d'une zone de texte
Set Texte = myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
X_texte, Y_texte, Long_connecteur, 60)
Texte.Rotation = Angle_fin
Texte.TextFrame.Characters.Text = Tache

Texte.Select
With Selection.Characters.Font
.Name = "Time New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Fill.Solid
.ShapeRange.Fill.Transparency = 1#
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSingle
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Transparency = 1#
.ShapeRange.Line.Visible = msoFalse
End With

Else
' Procédure de dessin du connecteur Fleche
Set Fleche = myDocument.Shapes.AddShape(msoShapeLeftRightArrow, X_rectangle, Y_rectangle, Long_connecteur, 5)
Fleche.Rotation = Angle_fin
With Fleche.Fill
.ForeColor.RGB = RGB(18, 228, 28)
.BackColor.RGB = RGB(170, 170, 170)
End With

' Procédure d'insertion d'une zone de texte
Set Texte = myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
X_texte, Y_texte, Long_connecteur, 60)
Texte.Rotation = Angle_fin
Texte.TextFrame.Characters.Text = Tache

Texte.Select
With Selection.Characters.Font
.Name = "Time New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.ShapeRange.Fill.Visible = msoFalse
.ShapeRange.Fill.Solid
.ShapeRange.Fill.Transparency = 1#
.ShapeRange.Line.Weight = 0.75
.ShapeRange.Line.DashStyle = msoLineSingle
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.Transparency = 1#
.ShapeRange.Line.Visible = msoFalse
End With
End If

End If

Loop Until vCellule = ""

MsgBox "Le planning est recalé"

End Sub

 

[Norah]

Re : changement de propriété de la zone de texte

L'erreur intervient au niveau de la propriété "ShapeRange" de mes zones de texte.

désolé pour cet oubli