Kako samodejno spremeniti velikost oblike glede na določeno vrednost celice v Excelu?
Če želite samodejno spremeniti velikost oblike glede na vrednost določene celice, vam lahko pomaga ta članek.
Samodejno spremeni velikost oblike na podlagi določene vrednosti celice s kodo VBA
Samodejno spremeni velikost oblike na podlagi določene vrednosti celice s kodo VBA
Naslednja koda VBA vam lahko pomaga spremeniti določeno velikost oblike glede na določeno vrednost celice na trenutnem delovnem listu. Naredite naslednje.
1. Z desno miškino tipko kliknite jeziček lista z obliko, ki jo želite spremeniti, in nato kliknite Ogled kode v meniju z desnim klikom.
2. V Ljubljani Microsoft Visual Basic za aplikacije okno, kopirajte in prilepite naslednjo kodo VBA v okno Code.
Koda VBA: Samodejno spremeni velikost oblike na podlagi določene vrednosti celice v Excelu
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
Opombe: V kodi je »Ovalni 2"Je ime oblike, spremenili boste njegovo velikost. In Vrstica = 2, Stolpec = 1 pomeni, da bo velikost oblike “Oval 2” spremenjena z vrednostjo v A2. Prosimo, spremenite jih po potrebi.
Za samodejno spreminjanje velikosti več oblik na podlagi različnih vrednosti celic uporabite spodnjo kodo VBA.
Koda VBA: Samodejno prilagodi velikost več oblik na podlagi vrednosti določenih celic v Excelu
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
Opombe:
3. Pritisnite druga + Q tipke hkrati, da zaprete tipko Microsoft Visual Basic za aplikacije okno.
Od zdaj naprej, ko spremenite vrednost v celici A2, se velikost oblike Oval 2 samodejno spremeni. Oglejte si posnetek zaslona:
Ali pa spremenite vrednosti v celicah A1, A2 in A3, da samodejno spremenite velikost ustreznih oblik "Oval 1", "Smiley Face 3" in "Heart 3". Oglejte si posnetek zaslona:
Opombe: Velikost oblike se ne bo več spreminjala, ko bo vrednost celice večja od 10.
Seznam in izvoz vseh oblik v trenutnem Excelovem delovnem zvezku:
O Izvozi grafiko uporabnost Kutools za Excel vam pomaga hitro našteti vse oblike v trenutnem delovnem zvezku in jih lahko vse hkrati izvozite v določeno mapo, kot je prikazano na spodnjem posnetku zaslona shwon. Prenesite in preizkusite zdaj! (30-dnevna prosta pot)
Sorodni članki:
- Kako dodati miško nad konico v določeno obliko v Excelu?
- Kako v Excelu zapolniti obliko s prozorno barvo ozadja?
- Kako skriti ali razkriti določeno obliko na podlagi določene vrednosti celice v Excelu?
Najboljša orodja za pisarniško produktivnost
Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%
- Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
- Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
- Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
- Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
- Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
- Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
- Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
- Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
- Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo
- Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
- Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
- Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
















