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 brezplačna 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 pisarniška orodja za produktivnost
Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa. Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...
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!