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...
