Sut i newid maint siâp yn awtomatig yn seiliedig / dibynnu ar werth celloedd penodedig yn Excel?
Os ydych chi am newid maint siâp yn awtomatig yn seiliedig ar werth cell benodol, gall yr erthygl hon eich helpu chi.
Newid maint siâp awto yn seiliedig ar werth celloedd penodedig gyda chod VBA
Newid maint siâp awto yn seiliedig ar werth celloedd penodedig gyda chod VBA
Gall y cod VBA canlynol eich helpu i newid maint siâp penodol yn seiliedig ar werth celloedd penodedig yn y daflen waith gyfredol. Gwnewch fel a ganlyn.
1. De-gliciwch y tab dalen gyda siâp sydd ei angen arnoch i newid maint, ac yna cliciwch Gweld y Cod o'r ddewislen clicio ar y dde.
2. Yn y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïo a gludo'r cod VBA canlynol i mewn i ffenestr y Cod.
Cod VBA: Maint siâp newid awto yn seiliedig ar werth celloedd penodedig yn 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
Nodyn: Yn y cod, “2 Oval”Yw'r enw siâp y byddwch chi'n newid ei faint. Ac Rhes = 2, Colofn = 1 yn golygu y bydd maint siâp “Oval 2” yn cael ei newid gyda'r gwerth yn A2. Newidiwch nhw yn ôl yr angen.
Ar gyfer newid maint siapiau lluosog yn seiliedig ar wahanol werthoedd celloedd, cymhwyswch y cod VBA isod.
Cod VBA: Ailfeintiwch siapiau lluosog yn seiliedig ar werth gwahanol gelloedd penodol yn 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
Nodiadau:
3. Gwasgwch Alt + Q allweddi ar yr un pryd i gau'r Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.
O hyn ymlaen, pan fyddwch chi'n newid y gwerth yng nghell A2, bydd maint siâp Oval 2 yn cael ei newid yn awtomatig. Gweler y screenshot:
Neu newidiwch y gwerthoedd yng nghell A1, A2 ac A3 i newid maint y siapiau cyfatebol "Oval 1", "Smiley Face 3" a "Heart 3" yn awtomatig. Gweler y screenshot:
Nodyn: Ni fydd maint y siâp yn newid mwyach pan fydd gwerth y gell yn fwy na 10.
Rhestrwch ac allforiwch bob siâp yn llyfr gwaith Excel cyfredol:
Mae adroddiadau Graffeg Allforio cyfleustodau Kutools ar gyfer Excel eich helpu i restru'r holl siapiau yn y llyfr gwaith cyfredol yn gyflym, a gallwch eu hallforio i gyd i ffolder benodol ar unwaith wrth i'r screenshot isod shwon. Dadlwythwch a rhowch gynnig arni nawr! (llwybr am ddim 30 diwrnod)
Erthyglau cysylltiedig:
- Sut i ychwanegu llygoden dros domen i siâp penodol yn Excel?
- Sut i lenwi siâp gyda lliw cefndir tryloyw yn Excel?
- Sut i guddio neu guddio siâp penodol yn seiliedig ar werth celloedd penodol yn Excel?
Offer Cynhyrchiant Swyddfa Gorau
Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser. Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...
Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer
- Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
- Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
- Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!