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

Wie kann ich die Formgröße basierend auf dem angegebenen Zellenwert in Excel automatisch ändern?

Wenn Sie die Formgröße basierend auf dem Wert einer angegebenen Zelle automatisch ändern möchten, kann Ihnen dieser Artikel helfen.

Automatische Änderung der Formgröße basierend auf dem angegebenen Zellenwert mit VBA-Code


Automatische Änderung der Formgröße basierend auf dem angegebenen Zellenwert mit VBA-Code

Der folgende VBA-Code kann Ihnen helfen, eine bestimmte Formgröße basierend auf dem im aktuellen Arbeitsblatt angegebenen Zellenwert zu ändern. Bitte gehen Sie wie folgt vor.

1. Klicken Sie mit der rechten Maustaste auf die Registerkarte "Blatt" mit der Form, deren Größe Sie ändern müssen, und klicken Sie dann auf Code anzeigen aus dem Kontextmenü.

2. In dem Microsoft Visual Basic für Applikationen Kopieren Sie den folgenden VBA-Code und fügen Sie ihn in das Codefenster ein.

VBA-Code: Formgröße automatisch basierend auf dem in Excel angegebenen Zellenwert ändern

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

Hinweis: Im Code “Oval 2”Ist der Formname, dessen Größe Sie ändern werden. Und Zeile = 2, Spalte = 1 bedeutet, dass die Größe der Form „Oval 2“ mit dem Wert in A2 geändert wird. Bitte ändern Sie sie nach Bedarf.

Wenden Sie den folgenden VBA-Code an, um die Größe mehrerer Formen basierend auf unterschiedlichen Zellenwerten automatisch zu ändern.

VBA-Code: Ändern Sie automatisch die Größe mehrerer Formen basierend auf dem Wert der verschiedenen angegebenen Zellen 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

Hinweise:

1) Im Code „Oval 1", "Smiley 3" und "Herz 3”Sind die Namen der Formen, deren Größe Sie automatisch ändern. Und A1, A2 und A3 sind die Zellen, deren Werte die Größe von Formen automatisch ändern.
2) Wenn Sie weitere Formen hinzufügen möchten, fügen Sie bitte Linien hinzu. "ElseIf xAddress = "A3" Dann"Und "Call SizeCircle (" Heart 2 ", Val (Target.Value))"über dem ersten"End If"Zeile im Code. Und ändern Sie die Zellenadresse und den Formnamen entsprechend Ihren Anforderungen.

3. Drücken Sie Andere + Q Tasten gleichzeitig zum Schließen der Microsoft Visual Basic für Applikationen Fenster.

Wenn Sie von nun an den Wert in Zelle A2 ändern, wird die Größe der Form Oval 2 automatisch geändert. Siehe Screenshot:

Oder ändern Sie die Werte in Zelle A1, A2 und A3, um die Größe der entsprechenden Formen "Oval 1", "Smiley Face 3" und "Heart 3" automatisch zu ändern. Siehe Screenshot:

Hinweis: Die Formgröße ändert sich nicht mehr, wenn der Zellenwert größer als 10 ist.


Listen Sie alle Formen in der aktuellen Excel-Arbeitsmappe auf und exportieren Sie sie:

Das Grafiken exportieren Nutzen von Kutools for Excel Sie können schnell alle Formen in der aktuellen Arbeitsmappe auflisten und sie alle gleichzeitig in einen bestimmten Ordner exportieren, wie im folgenden Screenshot gezeigt. Jetzt herunterladen und ausprobieren! (30-Tag kostenlose Loipe)


In Verbindung stehende Artikel:


Die besten Tools für die Office-Produktivität

Kutools for Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formelriegel (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2021 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. 30-tägige kostenlose Testversion mit allen Funktionen. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
officetab unten
Kommentare (16)
Noch keine Bewertungen. Bewerten Sie als Erster!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wie würden Sie dies mit mehreren Formen ausführen, die jeweils von verschiedenen Zellen abhängen?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Liebe Jade,
Der Artikel wurde mit einem neuen Codeabschnitt aktualisiert, der Ihnen bei der Ausführung mit mehreren Formen helfen kann, die jeweils von verschiedenen Zellen abhängen. Danke für deinen Kommentar.

Mit freundlichen Grüßen,
Kristall
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Wie benenne ich meine Form? Wie weisen Sie in Ihrem obigen Beispiel dem von Ihnen gezeichneten Kreis den Namen Oval 2 zu?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Liebe Ranjit,
Um eine Form zu benennen, wählen Sie bitte diese Form aus, geben Sie den Formnamen in das Namensfeld ein und drücken Sie dann die Eingabetaste. Siehe unten gezeigtes Bild.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, wie repliziere ich dasselbe für mehrere Formen, die mit mehreren Zellen im selben Modul verknüpft sind?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Liebe Abhinaya,
Der Artikel wurde mit einem neuen Codeabschnitt aktualisiert, der Ihnen bei der Ausführung mit mehreren Formen helfen kann, die jeweils von verschiedenen Zellen abhängen. Danke für deinen Kommentar.

Mit freundlichen Grüßen,
Kristall
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo,
Ich habe versucht, Ihren Beitrag zu verwenden, um meinen eigenen VBA-Code zu schreiben, aber ich scheine nicht sehr weit zu kommen. Hauptsächlich, weil ich VBA nicht wirklich verstehe und nur versuche, Ihre anzupassen. Ich habe mich gefragt, ob Sie helfen könnten. Ich möchte die Länge eines Rechtecks ​​abhängig vom Wert in einer Zelle ändern. Ich möchte, dass die Breite des Rechtecks ​​gleich bleibt, aber die Länge sich ändert. Ich möchte, dass beide linken Eckpunkte an derselben Stelle bleiben und sich nach rechts verlängern. Ist das möglich?
Vielen Dank.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Liebe Lan,
Hoffe, der folgende VBA-Code kann Ihr Problem lösen. (Bitte ersetzen Sie das Oval 1 durch Ihren eigenen Formnamen)

Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
On Error Resume Next
Wenn Target.Row = 2 und Target.Column = 1 Then
Aufruf SizeCircle("Oval 1", Val(Zielwert))
End If
End Sub
Sub SizeCircle(Name als Zeichenfolge, Durchmesser)
Dim xCircle As Shape
Dim xDiameter als Single
Bei Fehler GoTo ExitSub
xDurchmesser = Durchmesser
Wenn xDurchmesser > 10, dann ist xDurchmesser = 10
Wenn xDurchmesser < 1, dann ist xDurchmesser = 1
Setze xCircle = ActiveSheet.Shapes(Name)
xCircle.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
Mit xCircle
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(xDiameter)
Ende mit
ExitSub:
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo, gibt es eine Möglichkeit, die Form in zwei Dimensionen zu erweitern (anstatt die Formgröße um 5 zu erhöhen, erhöhen Sie sie horizontal um 5 und vertikal um 3)?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Lieber Sam,
Das folgende VBA-Skript kann Ihnen helfen, das Problem zu lösen. Und die beiden Dimensionen sind Zelle A1 und B1.

Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
On Error Resume Next
Wenn Target.Count = 1, dann
If Not Intersect(Target, Range("A1:B1")) ist Nothing Then
Aufruf SizeCircle("Oval 2", Array(Val(Range("A1").Value), Val(Range("B1").Value)))
End If
End If
End Sub
Sub SizeCircle(Name als String, Arr als Variante)
Dimme ich so lange
Dim xCenterX als Single
Dim xCenterY als Single
Dim xCircle As Shape
Bei Fehler GoTo ExitSub
Für I = 0 bis UBound(Arr)
Wenn Arr(I) > 10 Dann
Arr(I) = 10
ElseIf Arr(I) < 1 Then
Arr(I) = 1
End If
Weiter
Setze xCircle = ActiveSheet.Shapes(Name)
Mit xCircle
xCenterX = .Links + (.Breite / 2)
xCenterY = .Oben + (.Höhe / 2)
.Width = Application.CentimetersToPoints(Arr(0))
.Height = Application.CentimetersToPoints(Arr(1))
.Links = xCenterX - (.Breite / 2)
.Oben = xCenterY - (.Höhe / 2)
Ende mit
ExitSub:
End Sub
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gibt es eine Möglichkeit, dies mit Bildern zu tun? Ich scheine kein Glück zu haben, den Code wie gepostet zu verwenden.

5 Bilder in einer Bestenliste, ich möchte, dass die Bilder auf Platz 1 oder Platz 1 größer sind. Daher habe ich 2 feste Bildgrößen, entweder 1x2 für nicht Erstplatzierter oder 2x4 für Erstplatzierter (zum Beispiel). Ich habe bereits eine Rangfolge eingerichtet, sodass ich diese verwenden kann, um Größen in bestimmten Zellen für jedes Bild zu erstellen (dh verwenden Sie eine IF-Anweisung, damit IF RANK die 1. Größenbreite 1 beträgt). Mein VBA ist allerdings ziemlich schwach.

Grundsätzlich möchte ich - bei der Blattaktualisierung - auf Bildgrößenzellen schauen und jede Bildgröße auf das Ergebnis der spezifischen Bildgrößenzellen einstellen. Ich kann in der VBA oben nicht sehen, wie das genau funktioniert, aber ich denke, es sollte einfach sein!
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Kristall,

Ich möchte Sie fragen, ob es eine Möglichkeit gibt, Farbe (rote Zelle = rote Form) und Namen aus bestimmten Zellen auszuwählen. könnte es auch möglich sein, Formulare automatisch aus VBA zu erstellen?

Vielen Dank im Voraus :)

Weihnachtslied
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Kristall
Was wäre, wenn die Seite des Würfels, Dreiecks oder Kästchens anhand der Länge und Breite bestimmt werden müsste? Bitte hilf mir

Vielen Dank
Stuhl
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Chairill,
Tut mir leid, da kann ich dir noch nicht helfen. Vielen Dank für Ihren Kommentar.
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Gibt es eine Möglichkeit, dass dies funktioniert, wenn die Zelle, die Sie zum Festlegen der Größe verwenden, das Ergebnis einer Formel ist und nicht nur ein statischer Wert, den Sie manuell eingeben?
Dieser Kommentar wurde vom Moderator auf der Website minimiert
Hallo Mathnz, der folgende VBA-Code kann Ihnen helfen, das Problem zu lösen. Sie müssen nur die Wertzellen und die Formnamen im Code basierend auf Ihren eigenen Daten ändern.
Privates Unterarbeitsblatt_Calculate()
'Aktualisiert von Extendoffice 20211105
On Error Resume Next
Aufruf SizeCircle("Oval 1", Val(Range("A1").Value)) 'A1 ist die Wertzelle, Oval 1 ist der Name der Form
Aufruf SizeCircle("Smiley Face 2", Val(Range("A2").Value))
Aufruf SizeCircle("Herz 3", Val(Range("A3").Value))

End Sub
Private Sub Worksheet_Change (ByVal-Ziel als Bereich)
Dim xAddress als Zeichenfolge
On Error Resume Next
Wenn Target.CountLarge = 1, dann
xAdresse = Ziel.Adresse(0, 0)
Wenn xAddress = "A1" Dann
Aufruf SizeCircle("Oval 1", Val(Zielwert))
ElseIf xAddress = "A2" Dann
Aufruf SizeCircle("Smiley Face 2", Val(Target.Value))
ElseIf xAddress = "A3" Dann
Aufruf SizeCircle("Herz 3", Val(Zielwert))

End If
End If
End Sub

Sub SizeCircle(Name als Zeichenfolge, Durchmesser)
Dim xCenterX als Single
Dim xCenterY als Single
Dim xCircle As Shape
Dim xDiameter als Single
Bei Fehler GoTo ExitSub
xDurchmesser = Durchmesser
Wenn xDurchmesser > 10, dann ist xDurchmesser = 10
Wenn xDurchmesser < 1, dann ist xDurchmesser = 1
Setze xCircle = ActiveSheet.Shapes(Name)
Mit xCircle
xCenterX = .Links + (.Breite / 2)
xCenterY = .Oben + (.Höhe / 2)
.Width = Application.CentimetersToPoints(xDiameter)
.Höhe = Anwendung.CentimetersToPoints(xDiameter)
.Links = xCenterX - (.Breite / 2)
.Oben = xCenterY - (.Höhe / 2)
Ende mit
ExitSub:
End Sub

Es sind noch keine Kommentare vorhanden
Hinterlassen Sie Ihre Kommentare
Als Gast posten
×
Bewerte diese Nachricht:
0   Figuren
Vorgeschlagene Standorte

Folgen Sie uns

Copyright © 2009 - www.extendoffice.com. | Alle Rechte vorbehalten. Unterstützt von ExtendOffice. | Sitemap
Microsoft und das Office-Logo sind Marken oder eingetragene Marken der Microsoft Corporation in den USA und / oder anderen Ländern.
Geschützt durch Sectigo SSL