Tip: andere talen zijn Google-Vertaald. Je kunt het English versie van deze link.
Aanmelden
x
or
x
x
REGISTEREN
x

or

Hoe kan de vormgrootte automatisch worden aangepast / afhankelijk van de opgegeven celwaarde in Excel?

Als u de vorm automatisch wilt wijzigen op basis van de waarde van een opgegeven cel, kan dit artikel u helpen.

Auto-vorm wijzigen op basis van opgegeven celwaarde met VBA-code


Lijst en exporteer alle vormen in de huidige Excel-werkmap:

The Grafieken exporteren nut van Kutools for Excel helpt u snel alle vormen in de huidige werkmap weer te geven en u kunt ze allemaal tegelijk exporteren naar een bepaalde map. Zie screenshot:

Kutools for Excel bevat meer dan handige Excel-gereedschappen van 300. Gratis om te proberen zonder beperking in 60-dagen. Download nu de gratis proefversie

Tabblad Office Schakel bewerken en browsen met tabbladen in Office in en maak uw werk veel eenvoudiger ...
Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%
  • Alles hergebruiken: Voeg de meest gebruikte of complexe formules, grafieken en al het andere toe aan uw favorieten en hergebruik ze snel in de toekomst.
  • Meer dan 20-tekstfuncties: Nummer uit tekststring halen; Een deel van de tekst extraheren of verwijderen; Converteer getallen en valuta naar Engelse woorden.
  • Tools samenvoegen: Meerdere werkmappen en bladen in één; Meerdere cellen / rijen / kolommen samenvoegen zonder gegevens te verliezen; Dubbele rijen en som samenvoegen.
  • Split gereedschap: Gegevens splitsen in meerdere bladen op basis van waarde; Eén werkmap naar meerdere Excel-, PDF- of CSV-bestanden; Eén kolom naar meerdere kolommen.
  • Plakken overslaan Verborgen / gefilterde rijen; Tel en som op achtergrondkleur; Stuur gepersonaliseerde e-mails in bulk naar meerdere ontvangers.
  • Super filter: Maak geavanceerde filterschema's en pas deze toe op alle bladen; Soort per week, dag, frequentie en meer; filters door vetgedrukt, formules, commentaar ...
  • Meer dan 300 krachtige functies; Werkt met Office 2007-2019 en 365; Ondersteunt alle talen; Eenvoudig te implementeren in uw onderneming of organisatie.

Auto-vorm wijzigen op basis van opgegeven celwaarde met VBA-code


De volgende VBA-code kan u helpen om een ​​bepaalde vorm te wijzigen op basis van de opgegeven celwaarde in het huidige werkblad. Doe het als volgt.

1. Klik met de rechtermuisknop op het bladtabblad met de vorm die u wilt wijzigen en klik vervolgens op Bekijk code vanuit het rechtsklikmenu.

2. In de Microsoft Visual Basic voor toepassingen venster, kopieer en plak de volgende VBA-code in het codevenster.

VBA-code: Auto wijzig de vorm op basis van de opgegeven celwaarde in 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

Notes: In de code, "Ovaal 2"Is de vormnaam waarvan u de grootte wilt wijzigen. En Rij = 2, Kolom = 1 betekent dat de grootte van de vorm "Oval 2" zal worden gewijzigd met de waarde in A2. Wijzig ze als je nodig hebt.

Voor het automatisch aanpassen van de grootte van meerdere vormen op basis van verschillende celwaarden, moet u de onderstaande VBA-code toepassen.

VBA-code: automatisch de grootte van meerdere vormen wijzigen op basis van de waarde van verschillende opgegeven cellen in 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

Opmerkingen:

1) In de code, "Ovaal 1","Smiley Face 3"En"Hart 3"Zijn de naam van de vormen", dan zult u hun maten automatisch veranderen. En A1, A2 enA3 zijn de cellen met welke waarden u de grootte van shapes automatisch wilt aanpassen op basis van.

2) Als je meer vormen wilt toevoegen, voeg dan regels toe "ElseIf xAddress = "A3" Vervolgens"en "Call SizeCircle (" Heart 2 ", Val (Target.Value))"boven de eerste"End If"regel in de code en verander het celadres en de vormnaam op basis van uw behoeften.

3. druk op anders + Q toetsen tegelijkertijd om de Microsoft Visual Basic voor toepassingen venster.

Vanaf nu, wanneer u de waarde in cel A2 wijzigt, wordt de grootte van de vorm Oval 2 automatisch gewijzigd. Zie screenshot:

Of verander de waarden in de cellen A1, A2 en A3 om de corresponderende vormen "Oval 1", "Smiley Face 3" en "Heart 3" automatisch aan te passen. Zie screenshot:

Notes: De vorm wordt niet meer gewijzigd als de celwaarde groter is dan 10.


Gerelateerde artikelen:


Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Coderen van cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula Bar (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken op gefilterd bereik...
  • Cellen / rijen / kolommen samenvoegen zonder gegevens te verliezen; Inhoud gesplitste cellen; Combineer dubbele rijen / kolommen... voorkomen dubbele cellen; Ranges vergelijken...
  • Selecteer Dupliceren of Uniek rijen; Selecteer Lege rijen (alle cellen zijn leeg); Super Find en Fuzzy Find in veel werkboeken; Willekeurig selecteren ...
  • Exacte kopie Meerdere cellen zonder formule-referentie te wijzigen; Automatisch referenties maken naar meerdere vellen; Voeg kogels toe, Selectievakjes en meer ...
  • extract Text, Tekst toevoegen, verwijderen op positie, Verwijder de spatie; Subtotalen voor paging maken en afdrukken; Converteren tussen cellen Inhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerde sortering per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functionaliteit 30-daagse gratis proefversie.
kte-tab 201905

Tabblad Office Brengt interface met tabbladen naar Office en maakt uw werk veel eenvoudiger

  • Bewerken en lezen met tabbladen inschakelen in Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster, in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en verlaagt dagelijks honderden muisklikken voor u!
Officetab onderaan
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Chairil · 6 months ago
    Hi Crytal
    what if to determine the side of the cube, triangle, box that must be determined based on the length, width? Please help me

    Thank You
    chairil
    • To post as a guest, your comment is unpublished.
      crystal · 5 months ago
      Hi Chairil,
      Sorry can't help you with that yet. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    carol gomezgianine · 7 months ago
    Hi Crytal,

    I would like to ask you, if there is a way to select color (red cell = red form) and name from specific cells . could it also be possible to create forms automatically from VBA?

    Thank you so much in advance :)

    Carol


  • To post as a guest, your comment is unpublished.
    Andrew · 1 years ago
    Is there a way to do this with Images? I don't seem to be having any luck using the code as posted.

    5 Images in a leaderboard, I want the Images in 1st or tied for 1st to be larger. Therefore I've 2 fixed image sizes, either 1x2 for not first or 2x4 for 1st placed (for example). I've got ranking already set-up so can use that to create sizes in specific cells for each image (ie use an IF statement so IF RANK is 1st size width is 2). My VBA is pretty weak though.

    Basically I want - on sheet update - look at image size cells and set each image size to the specific image size cells result. I can't see in the VBA above how that exactly works but I think it should be easy!
  • To post as a guest, your comment is unpublished.
    Sam · 1 years ago
    Hi, is there a way that I can make the shape expand on two dimensions (instead of increasing the shape size by 5, increase it 5 on the horizontal and 3 on the vertical)?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear Sam,
      The following VBA script can help you solve the problem. And the two dimensions are cell A1 and B1.

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Count = 1 Then
      If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
      Call SizeCircle("Oval 2", Array(Val(Range("A1").Value), Val(Range("B1").Value)))
      End If
      End If
      End Sub
      Sub SizeCircle(Name As String, Arr As Variant)
      Dim I As Long
      Dim xCenterX As Single
      Dim xCenterY As Single
      Dim xCircle As Shape
      On Error GoTo ExitSub
      For I = 0 To UBound(Arr)
      If Arr(I) > 10 Then
      Arr(I) = 10
      ElseIf Arr(I) < 1 Then
      Arr(I) = 1
      End If
      Next
      Set xCircle = ActiveSheet.Shapes(Name)
      With xCircle
      xCenterX = .Left + (.Width / 2)
      xCenterY = .Top + (.Height / 2)
      .Width = Application.CentimetersToPoints(Arr(0))
      .Height = Application.CentimetersToPoints(Arr(1))
      .Left = xCenterX - (.Width / 2)
      .Top = xCenterY - (.Height / 2)
      End With
      ExitSub:
      End Sub
  • To post as a guest, your comment is unpublished.
    Ian · 2 years ago
    Hi,
    I have tried to use your post to write my own VBA code but don't seem to be getting very far. Mainly because I don't really understand VBA and I'm just trying to adapt your. I was wondering if you could help. I am wanting to change the length of a rectangle depending on the value in a cell. I would like the width if the rectangle to stay the same but the length to change. I would like both left hand vertices to stay in the same place and it to lengthen to the right. Is this possible?
    Thank you
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear lan,
      Hope the following VBA code can solve your problem. (Please replace the Oval 1 with the shape name of your own)

      Private Sub Worksheet_Change(ByVal Target As Range)
      On Error Resume Next
      If Target.Row = 2 And Target.Column = 1 Then
      Call SizeCircle("Oval 1", Val(Target.Value))
      End If
      End Sub
      Sub SizeCircle(Name As String, Diameter)
      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)
      xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
      With xCircle
      .LockAspectRatio = msoFalse
      .Width = Application.CentimetersToPoints(xDiameter)
      End With
      ExitSub:
      End Sub
  • To post as a guest, your comment is unpublished.
    Abhinaya · 2 years ago
    Hi, how do i replicate the same for multiple shapes linked to multiple cells in the same module?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Abhinaya,
      The article is updated with a new code section which can help you to execute with multiple shapes each depending on different cells. Thank you for your comment.

      Best Regards,
      Crystal
  • To post as a guest, your comment is unpublished.
    Ranjit Konkar · 2 years ago
    How do I name my shape? In your example above, how do you assign the name Oval 2 to the circle you have drawn?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Ranjit,
      For naming a shape, please select this shape, enter the shape name into the Name Box, and then press the Enter key. See below image shown.
  • To post as a guest, your comment is unpublished.
    Jade · 2 years ago
    How would you execute this with multiple shapes each depending on different cells?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Jade,
      The article is updated with a new code section which can help you to execute with multiple shapes each depending on different cells. Thank you for your comment.

      Best Regards,
      Crystal