Insertar, modificar y posicionar autoformas VBA
Quiero insertar las siguientes autoformas mediante código:
Flecha vertical señalando hacia arriba
Flecha horizontal señalando hacia la derecha
Rectángulo vertical
Rectángulo horizontal
Después modificar su color y colocarlos en zonas concretas de un gráfico.
He probado a utilizar la grabadora pero no queda registrado :(
Flecha vertical señalando hacia arriba
Flecha horizontal señalando hacia la derecha
Rectángulo vertical
Rectángulo horizontal
Después modificar su color y colocarlos en zonas concretas de un gráfico.
He probado a utilizar la grabadora pero no queda registrado :(
1 Respuesta
Respuesta de Cadipas spain
2
Prueba esto...
Sub FlechaArriba()
ActiveSheet.Shapes.AddShape(msoShapeUpArrow, 100, 98, 127, 163).Select
c = colores(13, 1)
End Sub
Sub rectangulo()
ActiveSheet. Shapes. AddShape(msoShapeRectangle, 100#, 100#, 100, 150). Select
'( posicion x , posicion y , ancho,alto)
c = colores(13, 1)
End Sub
Sub FlechaDerecha()
ActiveSheet. Shapes. AddShape(msoShapeRightArrow, 100#, 100, 100#, 100). Select
'( posicion x , posicion y , ancho,alto)
c = colores(13, 1)
End Sub
Function colores(colorin As Byte, colorLinea As Byte)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = colorin
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = colorLinea
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Range("a1").Select
End Function
'-------------------------
NOTA,.- Si ejecutas FlechaArriba te crea una flecha mirando arriba del color de relleno y linea que le digas en "colores(colorinterior, colorLinea)", como ves puedes crear de diferentes colores las distintas formas.
Espero que te haya entendido el problema... y sea estala solución.
Sub FlechaArriba()
ActiveSheet.Shapes.AddShape(msoShapeUpArrow, 100, 98, 127, 163).Select
c = colores(13, 1)
End Sub
Sub rectangulo()
ActiveSheet. Shapes. AddShape(msoShapeRectangle, 100#, 100#, 100, 150). Select
'( posicion x , posicion y , ancho,alto)
c = colores(13, 1)
End Sub
Sub FlechaDerecha()
ActiveSheet. Shapes. AddShape(msoShapeRightArrow, 100#, 100, 100#, 100). Select
'( posicion x , posicion y , ancho,alto)
c = colores(13, 1)
End Sub
Function colores(colorin As Byte, colorLinea As Byte)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = colorin
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = colorLinea
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Range("a1").Select
End Function
'-------------------------
NOTA,.- Si ejecutas FlechaArriba te crea una flecha mirando arriba del color de relleno y linea que le digas en "colores(colorinterior, colorLinea)", como ves puedes crear de diferentes colores las distintas formas.
Espero que te haya entendido el problema... y sea estala solución.
