Colocar texto en gráfico creado con macro

[uzziber]

Buenas Tardes!! Agradeceré su ayuda con una macro...
El objetivo es crear un gráfico en la hoja Planeación, con los pedidos que se reciben y se registran en la hoja Recepción.
Al generar el gráfico, lo que deseo es agregar a cada cuadro (pedido) un cuadro de texto con el número de pedido, lo he intentado y no lo he logrado; ojalá ustedes puedan ayudarme a resolverlo.

la macro que he hecho es ésta:

Sub GráficoPlaneación()
'Planeación Macro
'Generación de Gráfico para estimar tiempos de entrega
'
'Acceso Directo: Ctrl+G
'
'
Aviso10 = MsgBox("Gráfico de Planeación," & (Chr(13)) & _
"Coloca el cursor en la celda inicial?", vbOKCancel, "Planeación")

If Aviso10 = vbCancel Then
End
End If


r = ActiveCell.Row
f = ActiveCell.Column
a = 12.75
poshor = 120
Capacidad = 300
posvert = 190


Dia = InputBox("Dia de Inicio?", "Carga de Datos")
KgHora = InputBox("Kilos x hora?", "Carga de Datos")

retorno:

Orden = ActiveCell.Value
If Orden = "" Then
GoTo salida
End If

Ton = Cells(ActiveCell.Row, (f + 6)).Value

LargoGraf = (Ton / KgHora) * 12.2
If Capacidad > LargoGraf Then

Sheets("Planeación").Activate
Color1 = Int((255 * Rnd) + 1)
Color2 = Int((255 * Rnd) + 1)
Color3 = Int((255 * Rnd) + 1)

With ActiveSheet.Shapes
' .AddShape Type:=1, Left:=poshor, Top:=posvert, _
' Width:=LargoGraf, Height:=a
.AddShape(msoShapeRectangle, poshor, posvert, LargoGraf, a) _
.Fill.ForeColor.RGB = RGB(Color1, Color2, Color3)
End With

'With ActiveSheet.Shapes
' .AddShape Type:=1, Left:=120, Top:=190, _
' Width:=largo2Graf * 12.3, Height:=12.75
' If LArgo3Graf > 0 Then
' With ActiveSheet.Shapes
' .AddShape Type:=1, Left:=120, Top:=190 - 12.75, _
' Width:=LArgo3Graf * 12.3, Height:=12.75
' End With
' End If
'End With

poshor = poshor + LargoGraf
Capacidad = Capacidad - LargoGraf

ElseIf Capacidad < LargoGraf Then

Largo2Graf = LargoGraf - Capacidad
If Largo2Graf > 300 Then
Largo3Graf = Largo2Graf - 300

Sheets("Planeación").Activate
Cal1 = Int((100 * Rnd) + 1)
Cal2 = Int((100 * Rnd) + 1)
Cal3 = Int((100 * Rnd) + 1)
With ActiveSheet.Shapes
.AddShape(msoShapeRectangle, poshor, posvert, Capacidad, 12.75) _
.Fill.ForeColor.RGB = RGB(Cal1, Cal2, Cal3)
.AddShape(msoShapeRectangle, 120, posvert - a, 300, 12.75) _
.Fill.ForeColor.RGB = RGB(Cal1, Cal2, Cal3)
.AddShape(msoShapeRectangle, 120, posvert - (2 * a), Largo3Graf, 12.75) _
.Fill.ForeColor.RGB = RGB(Cal1, Cal2, Cal3)

poshor = 120 + Largo3Graf
posvert = posvert - (2 * a)
Capacidad = 300 - Largo3Graf

End With
GoTo neo
End If

Sheets("Planeación").Activate
Col1 = Int((150 * Rnd) + 1)
Col2 = Int((150 * Rnd) + 1)
Col3 = Int((150 * Rnd) + 1)

With ActiveSheet.Shapes
' .AddShape Type:=1, Left:=poshor, Top:=190, _
' Width:=capacidad, Height:=a
' .AddShape Type:=1, Left:=120, Top:=190 - a, _
' Width:=Largo2Graf, Heigth:=a
.AddShape(msoShapeRectangle, poshor, posvert, Capacidad, 12.75) _
.Fill.ForeColor.RGB = RGB(Col1, Col2, Col3)
.AddShape(msoShapeRectangle, 120, posvert - a, Largo2Graf, 12.75) _
.Fill.ForeColor.RGB = RGB(Col1, Col2, Col3)

poshor = 120
posvert = posvert - a
Capacidad = 300

End With

poshor = poshor + Largo2Graf
Capacidad = Capacidad - Largo2Graf
neo:
End If

Sheets("Recepción").Activate
ActiveCell.Offset(Rowoffset:=1).Activate


GoTo retorno

salida:
Sheets("Planeación").Activate
Sheets("Planeación").Shapes.SelectAll


f = f + 1
End Sub

Existen líneas que no tienen función alguna, parte de lo que he intentado hacer.
Agradeceré su ayuda...