Note: The other languages of the website are Google-translated. Back to English

¿Cómo cambiar automáticamente el tamaño de la forma según / dependiente del valor de celda especificado en Excel?

Si desea cambiar automáticamente el tamaño de la forma según el valor de una celda específica, este artículo puede ayudarlo.

Cambiar automáticamente el tamaño de la forma según el valor de celda especificado con código VBA


Cambiar automáticamente el tamaño de la forma según el valor de celda especificado con código VBA

El siguiente código de VBA puede ayudarlo a cambiar un cierto tamaño de forma según el valor de celda especificado en la hoja de trabajo actual. Haz lo siguiente.

1. Haga clic con el botón derecho en la pestaña de la hoja con la forma que necesita para cambiar el tamaño y luego haga clic en Ver código desde el menú contextual.

2. En el Microsoft Visual Basic para aplicaciones ventana, copie y pegue el siguiente código VBA en la ventana Código.

Código de VBA: cambio automático del tamaño de la forma según el valor de celda especificado en Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Nota:: En el código, "Oval 2”Es el nombre de la forma, cambiará su tamaño. Y Row = 2, Columna = 1 significa que el tamaño de la forma "Oval 2" se cambiará con el valor en A2. Cámbielos según sea necesario.

Para cambiar automáticamente el tamaño de varias formas basadas en diferentes valores de celda, aplique el siguiente código VBA.

Código de VBA: cambie automáticamente el tamaño de varias formas según el valor de diferentes celdas especificadas en Excel

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

Notas

1) En el código, "Oval 1,Cara sonriente 3 y Corazón 3”Son el nombre de las formas, cambiará sus tamaños automáticamente. Y A1, A2 yA3 son las celdas en las que cambiará automáticamente el tamaño de las formas según los valores.
2) Si desea agregar más formas, agregue líneas "ElseIf xAddress = "A3" Entonces"Y "Call SizeCircle (" Corazón 2 ", Val (Target.Value))"por encima del primero"Si terminar"en la línea del código. Y cambie la dirección de la celda y el nombre de la forma según sus necesidades.

3. Prensa otro + Q teclas simultáneamente para cerrar el Microsoft Visual Basic para aplicaciones ventana.

De ahora en adelante, cuando cambie el valor en la celda A2, el tamaño de la forma Oval 2 se cambiará automáticamente. Ver captura de pantalla:

O cambie los valores en las celdas A1, A2 y A3 para cambiar el tamaño de las formas correspondientes "Oval 1", "Smiley Face 3" y "Heart 3" automáticamente. Ver captura de pantalla:

Nota:: El tamaño de la forma ya no cambiará cuando el valor de la celda sea mayor que 10.


Enumere y exporte todas las formas en el libro de Excel actual:

Programas de Exportar gráficos utilidad de Kutools for Excel ayudarlo a enumerar rápidamente todas las formas en el libro de trabajo actual, y puede exportarlas todas a una carpeta determinada a la vez, como se muestra en la siguiente captura de pantalla. ¡Descárgalo y pruébalo ahora! (30-día de ruta libre)


Artículos relacionados:


Las mejores herramientas de productividad de oficina

Kutools para Excel resuelve la mayoría de sus problemas y aumenta su productividad en un 80%

  • Reutilizar: Inserte rápidamente fórmulas complejas, gráficos y cualquier cosa que hayas usado antes; Cifrar celdas con contraseña; Crear lista de distribución y enviar correos electrónicos ...
  • Barra de súper fórmula (edite fácilmente varias líneas de texto y fórmulas); Diseño de lectura (leer y editar fácilmente un gran número de celdas); Pegar en rango filtrado...
  • Combinar celdas / filas / columnas sin perder datos; Contenido de celdas divididas; Combinar filas / columnas duplicadas... Prevenir celdas duplicadas; Comparar rangos...
  • Seleccione Duplicado o Único Filas; Seleccionar filas en blanco (todas las celdas están vacías); Super Find y Fuzzy Find en muchos libros de trabajo; Selección aleatoria ...
  • Copia exacta Varias celdas sin cambiar la referencia de la fórmula; Crear referencias automáticamente a varias hojas; Insertar viñetas, Casillas de verificación y más ...
  • Extraer texto, Agregar texto, Eliminar por posición, Quitar espacio; Crear e imprimir subtotales de paginación; Convertir entre contenido de celdas y comentarios...
  • Súper filtro (guardar y aplicar esquemas de filtros a otras hojas); Orden avanzado por mes / semana / día, frecuencia y más; Filtro especial en negrita, cursiva ...
  • Combinar libros y hojas de trabajo; Combinar tablas basadas en columnas clave; Dividir datos en varias hojas; Conversión por lotes de xls, xlsx y PDF...
  • Más de 300 potentes funciones. Compatible con Office/Excel 2007-2021 y 365. Compatible con todos los idiomas. Fácil implementación en su empresa u organización. Funciones completas Prueba gratuita de 30 días. Garantía de devolución de dinero de 60 días.
pestaña kte 201905

Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil

  • Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
  • Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
  • ¡Aumenta su productividad en un 50% y reduce cientos de clics del mouse todos los días!
officetab parte inferior
Comentarios (16)
Aún no hay calificaciones. ¡Sé el primero en calificar!
Este comentario fue minimizado por el moderador en el sitio
¿Cómo ejecutaría esto con múltiples formas, cada una dependiendo de diferentes celdas?
Este comentario fue minimizado por el moderador en el sitio
Estimado Jade,
El artículo se actualiza con una nueva sección de código que puede ayudarlo a ejecutar con múltiples formas, cada una dependiendo de diferentes celdas. Gracias por tu comentario.

Atentamente,
Cristal
Este comentario fue minimizado por el moderador en el sitio
¿Cómo nombro mi forma? En su ejemplo anterior, ¿cómo asigna el nombre Oval 2 al círculo que ha dibujado?
Este comentario fue minimizado por el moderador en el sitio
Estimado Ranjit,
Para nombrar una forma, seleccione esta forma, ingrese el nombre de la forma en el Cuadro de nombre y luego presione la tecla Intro. Vea la imagen a continuación que se muestra.
Este comentario fue minimizado por el moderador en el sitio
Hola, ¿cómo puedo replicar lo mismo para múltiples formas vinculadas a múltiples celdas en el mismo módulo?
Este comentario fue minimizado por el moderador en el sitio
Estimado Abhinaya,
El artículo se actualiza con una nueva sección de código que puede ayudarlo a ejecutar con múltiples formas, cada una dependiendo de diferentes celdas. Gracias por tu comentario.

Atentamente,
Cristal
Este comentario fue minimizado por el moderador en el sitio
Hola,
Intenté usar su publicación para escribir mi propio código VBA, pero parece que no estoy llegando muy lejos. Principalmente porque realmente no entiendo VBA y solo estoy tratando de adaptar tu. Me preguntaba si podrías ayudar. Quiero cambiar la longitud de un rectángulo según el valor en una celda. Me gustaría que el ancho del rectángulo se mantuviera igual pero que la longitud cambiara. Me gustaría que ambos vértices de la mano izquierda permanezcan en el mismo lugar y que se alarguen hacia la derecha. es posible?
Gracias
Este comentario fue minimizado por el moderador en el sitio
Estimado Ian,
Espero que el siguiente código VBA pueda resolver su problema. (Reemplace el óvalo 1 con su propio nombre de forma)

Sub hoja de trabajo privada_Cambio (según el rango de destino ByVal)
On Error Resume Next
Si Target.Row = 2 y Target.Column = 1 Entonces
Llamar a SizeCircle("Oval 1", Val(Objetivo.Valor))
Si terminar
End Sub
Sub SizeCircle (nombre como cadena, diámetro)
Dim xCircle como forma
Dim xDiámetro como individual
En caso de error Ir a ExitSub
xDiámetro = Diámetro
Si xDiámetro > 10 Entonces xDiámetro = 10
Si xDiámetro < 1 Entonces xDiámetro = 1
Establecer xCircle = ActiveSheet.Shapes (Nombre)
xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
Con xCírculo
.LockAspectRatio = msoFalse
.Ancho = Aplicación.CentímetrosAPuntos(xDiámetro)
End With
ExitSub:
End Sub
Este comentario fue minimizado por el moderador en el sitio
Hola, ¿hay alguna manera de que pueda hacer que la forma se expanda en dos dimensiones (en lugar de aumentar el tamaño de la forma en 5, aumentarlo 5 en la horizontal y 3 en la vertical)?
Este comentario fue minimizado por el moderador en el sitio
Querido Sam,
El siguiente script de VBA puede ayudarlo a resolver el problema. Y las dos dimensiones son la celda A1 y B1.

Sub hoja de trabajo privada_Cambio (según el rango de destino ByVal)
On Error Resume Next
Si Target.Count = 1 Entonces
Si no intersecta (objetivo, rango ("A1: B1")) no es nada, entonces
Llamar a SizeCircle("Oval 2", Array(Val(Rango("A1").Valor), Val(Rango("B1").Valor)))
Si terminar
Si terminar
End Sub
Sub SizeCircle (Nombre como cadena, Arr como variante)
Dim I tan largo
Dim xCenterX como único
Dim xCenterY como único
Dim xCircle como forma
En caso de error Ir a ExitSub
Para I = 0 Para UBound(Arr)
Si Arr(I) > 10 Entonces
Arr(I) = 10
ElseIf Arr(I) < 1 Entonces
Arr(I) = 1
Si terminar
Siguiente
Establecer xCircle = ActiveSheet.Shapes (Nombre)
Con xCírculo
xCentroX = .Izquierda + (.Ancho / 2)
xCentroY = .Arriba + (.Altura / 2)
.Ancho = Aplicación.CentímetrosAPuntos(Arr(0))
.Altura = Aplicación.CentímetrosAPuntos(Arr(1))
.Izquierda = xCentroX - (.Ancho / 2)
.Superior = xCentroY - (.Altura / 2)
End With
ExitSub:
End Sub
Este comentario fue minimizado por el moderador en el sitio
¿Hay alguna manera de hacer esto con Imágenes? Parece que no estoy teniendo suerte con el código publicado.

5 imágenes en una tabla de clasificación, quiero que las imágenes en primer lugar o empatadas en primer lugar sean más grandes. Por lo tanto, tengo 1 tamaños de imagen fijos, ya sea 1x2 para no ser el primero o 1x2 para el 2er puesto (por ejemplo). Ya tengo la clasificación configurada, así que puedo usar eso para crear tamaños en celdas específicas para cada imagen (es decir, use una declaración IF para que IF RANK sea 4st size width es 1). Sin embargo, mi VBA es bastante débil.

Básicamente, quiero, en la actualización de la hoja, mirar las celdas de tamaño de imagen y establecer cada tamaño de imagen en el resultado específico de las celdas de tamaño de imagen. No puedo ver en el VBA anterior cómo funciona exactamente, ¡pero creo que debería ser fácil!
Este comentario fue minimizado por el moderador en el sitio
Hola Crytal,

Me gustaría preguntarle si hay una forma de seleccionar el color (celda roja = forma roja) y el nombre de celdas específicas. ¿También sería posible crear formularios automáticamente desde VBA?

Muchas gracias de antemano :)

Carol
Este comentario fue minimizado por el moderador en el sitio
hola cristal
¿Qué pasa si para determinar el lado del cubo, triángulo, caja que debe determinarse en función de la longitud, el ancho? por favor, ayúdame

Gracias
silla
Este comentario fue minimizado por el moderador en el sitio
Hola Chairil,
Lo siento, no puedo ayudarte con eso todavía. Gracias por tu comentario.
Este comentario fue minimizado por el moderador en el sitio
¿Hay alguna manera de que esto funcione si la celda que está usando para establecer el tamaño es el resultado de una fórmula en lugar de solo un valor estático que ingresa manualmente?
Este comentario fue minimizado por el moderador en el sitio
Hola, Mathnz, el siguiente código de VBA puede ayudarlo a resolver el problema. Solo necesita cambiar las celdas de valor y los nombres de las formas en el código según sus propios datos.
Hoja de trabajo secundaria privada_Calculate ()
'Actualizado por Extendoffice 20211105
On Error Resume Next
Llamar a SizeCircle("Oval 1", Val(Rango("A1").Valor)) 'A1 es la celda de valor, Oval 1 es el nombre de la forma
Llamar a SizeCircle("Smiley Face 2", Val(Rango("A2").Valor))
Llamar a SizeCircle("Corazón 3", Val(Rango("A3").Valor))

End Sub
Sub hoja de trabajo privada_Cambio (según el rango de destino ByVal)
Dim xAddress como cadena
On Error Resume Next
Si Target.CountLarge = 1 Entonces
xDirección = Destino.Dirección(0, 0)
Si xAddress = "A1" Entonces
Llamar a SizeCircle("Oval 1", Val(Objetivo.Valor))
ElseIf xAddress = "A2" Entonces
Llamar a SizeCircle("Smiley Face 2", Val(Objetivo.Valor))
ElseIf xAddress = "A3" Entonces
Llamar a SizeCircle("Corazón 3", Val(Objetivo.Valor))

Si terminar
Si terminar
End Sub

Sub SizeCircle (nombre como cadena, diámetro)
Dim xCenterX como único
Dim xCenterY como único
Dim xCircle como forma
Dim xDiámetro como individual
En caso de error Ir a ExitSub
xDiámetro = Diámetro
Si xDiámetro > 10 Entonces xDiámetro = 10
Si xDiámetro < 1 Entonces xDiámetro = 1
Establecer xCircle = ActiveSheet.Shapes (Nombre)
Con xCírculo
xCentroX = .Izquierda + (.Ancho / 2)
xCentroY = .Arriba + (.Altura / 2)
.Ancho = Aplicación.CentímetrosAPuntos(xDiámetro)
.Altura = Aplicación.CentímetrosAPuntos(xDiámetro)
.Izquierda = xCentroX - (.Ancho / 2)
.Superior = xCentroY - (.Altura / 2)
End With
ExitSub:
End Sub

No hay comentarios publicados aquí todavía
Deje sus comentarios
Publicar como invitado
×
Califica esta publicación:
0   Personajes
Ubicaciones sugeridas

Seguinos

Copyright © 2009 - www.extendoffice.com. | Reservados todos los derechos. Energizado por ExtendOffice, | Mapa del Sitio
Microsoft y el logotipo de Office son marcas comerciales o marcas comerciales registradas de Microsoft Corporation en los Estados Unidos y / o en otros países.
Protegido por Sectigo SSL