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

Sut i newid lliw siâp yn seiliedig ar werth celloedd yn Excel?

Gall newid lliw siâp yn seiliedig ar werth celloedd penodol fod yn dasg ddiddorol yn Excel, er enghraifft, os yw gwerth y gell yn A1 yn llai na 100, mae lliw y siâp yn goch, os yw A1 yn fwy na 100 ac yn llai na 200, bydd y mae lliw siâp yn felyn, a phan fydd A1 yn fwy na 200, mae lliw y siâp yn wyrdd fel y dangosir y screenshot canlynol. I newid lliw y siâp yn seiliedig ar werth cell, bydd yr erthygl hon yn cyflwyno dull i chi.

newid lliw siâp 1

Newid lliw siâp yn seiliedig ar werth celloedd gyda chod VBA

swigen dde glas saeth Newid lliw siâp yn seiliedig ar werth celloedd gyda chod VBA

Gall y cod VBA isod eich helpu chi i newid lliw siâp yn seiliedig ar werth cell, gwnewch fel a ganlyn:

1. Cliciwch ar y dde ar y tab dalen rydych chi am newid lliw siâp, ac yna dewiswch Gweld y Cod o'r ddewislen cyd-destun, yn y popped allan Microsoft Visual Basic ar gyfer Ceisiadau ffenestr, copïwch a gludwch y cod canlynol i'r gwag Modiwlau ffenestr.

Cod VBA: Newid lliw siâp yn seiliedig ar werth celloedd:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160704
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) Then
        If Target.Value < 100 Then
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
        ElseIf Target.Value >= 100 And Target.Value < 200 Then
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbYellow
        Else
            ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
        End If
    End If
End Sub

newid lliw siâp 2

2. Ac yna pan fyddwch chi'n nodi'r gwerth yng nghell A1, bydd lliw'r siâp yn cael ei newid gyda gwerth y gell fel y gwnaethoch chi ei ddiffinio.

Nodyn: Yn y cod uchod, A1 yw'r gwerth cell y byddai eich lliw siâp yn cael ei newid yn seiliedig ar, a'r 1 Oval yw enw siâp eich siâp wedi'i fewnosod, gallwch eu newid i'ch angen.

Yr Offer Cynhyrchedd Swyddfa Gorau

Mae Kutools for Excel yn Datrys y rhan fwyaf o'ch Problemau, ac yn Cynyddu Eich Cynhyrchedd 80%

  • Ailddefnyddio: Mewnosod yn gyflym fformwlâu cymhleth, siartiau ac unrhyw beth rydych chi wedi'i ddefnyddio o'r blaen; Amgryptio Celloedd gyda chyfrinair; Creu Rhestr Bostio ac anfon e-byst ...
  • Bar Fformiwla Gwych (golygu llinellau lluosog o destun a fformiwla yn hawdd); Cynllun Darllen (darllen a golygu nifer fawr o gelloedd yn hawdd); Gludo i'r Ystod Hidlo...
  • Uno Celloedd / Rhesi / Colofnau heb golli Data; Cynnwys Celloedd Hollt; Cyfuno Rhesi / Colofnau Dyblyg... Atal Celloedd Dyblyg; Cymharwch y Meysydd...
  • Dewiswch Dyblyg neu Unigryw Rhesi; Dewiswch Blank Rows (mae pob cell yn wag); Darganfyddiad Gwych a Darganfyddiad Niwlog mewn Llawer o Lyfrau Gwaith; Dewis ar Hap ...
  • Copi Union Celloedd Lluosog heb newid cyfeirnod fformiwla; Auto Creu Cyfeiriadau i Daflenni Lluosog; Mewnosod Bwledi, Blychau Gwirio a mwy ...
  • Testun Detholiad, Ychwanegu Testun, Tynnu yn ôl Swydd, Tynnwch y Gofod; Creu ac Argraffu Subtotals Paging; Trosi rhwng Cynnwys a Sylwadau Celloedd...
  • Hidlo Super (arbed a chymhwyso cynlluniau hidlo i ddalenni eraill); Trefnu Uwch yn ôl mis / wythnos / dydd, amlder a mwy; Hidlo Arbennig gan feiddgar, italig ...
  • Cyfuno Llyfrau Gwaith a Thaflenni Gwaith; Uno Tablau yn seiliedig ar golofnau allweddol; Rhannwch Ddata yn Daflenni Lluosog; Trosi Swp xls, xlsx a PDF...
  • Mwy na 300 o nodweddion pwerus. Yn cefnogi Office / Excel 2007-2021 a 365. Yn cefnogi pob iaith. Defnydd hawdd yn eich menter neu sefydliad. Nodweddion llawn treial am ddim 30 diwrnod. Gwarant arian yn ôl 60 diwrnod.
tab kte 201905

Mae Tab Office yn Dod â rhyngwyneb Tabbed i'r Swyddfa, a 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!
gwaelod officetab
sylwadau (21)
Wedi graddio 4 allan o 5 · Graddfeydd 1
Edward
Edward
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Beth am os oes gennym ni fwy nag 1 gwrthrych yn y daflen waith lle mae'r lliwiau'n newid yn ôl y mewnbwn gwerth dywedwch yn A1, B1, C1.
ateb
0
0
MandyZhou
MandyZhou     Edward
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Edward,
Falch i helpu. Copïwch a gludwch y cod VBA isod i ffenestr wag y Modiwl.

Is-brawfMacro2()
Dim dblHt Fel Dwbl
Dim rngC Fel Ystod
Dim lngr Cyhyd
Dim dblMargin Fel Dwbl
Dim lngSR Cyhyd

lngSR = 2 'Rhes lle mae'r data'n dechrau

dblMargin = 6 ' Pellter rhwng siapiau

'Ar Gwall Ailddechrau Nesaf
ActiveSheet.Shapes.SelectAll
Dewis.Dileu
Ar Gwall Ewch i 0


dblHt = Rhesi(lngSR).Uchder * 4

Ar gyfer lngr = lngSR I Gelloedd(lngSR, "A").Diwedd(xlDown).Rhes
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celloedd(lngSR, "D"). Chwith + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Celloedd(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Dewiswch
Selection.Name = "Rownd" & Celloedd(lngr, "A").Cyfeiriad
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Celloedd(lngr, "A").Value
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Diwedd Gyda
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Llenwi.Solid
.Maint = 12
Diwedd Gyda
Gyda Selection.ShapeRange.Fill
.Gweladwy = msoTrue
Os Celloedd(lngr, "A").Gwerth > 70 Yna
.ForeColor.RGB = RGB(0, 176, 80)
Celloedd Arall(lngr, "A").Gwerth >= 40 Yna
.ForeColor.RGB = RGB(255, 255, 70)
arall
.ForeColor.RGB = RGB(255, 0, 0)
Gorffennwch Os
.Tryloywder = 0
.Soled
Diwedd Gyda
Lngr nesaf
Ystod ("A1"). Dewiswch
Is-End

Ar ôl i chi redeg y cod VBA uchod, fe welwch siapiau lluosog yn cael eu cynhyrchu, ac mae lliwiau'r siapiau hyn yn cael eu newid yn ôl y VBA.
Os gwelwch yn dda weld fy screenshot. Gobeithio y gall helpu. Cael diwrnod braf.
Yn gywir,
Mandy
Gweld Atodiadau (1 / 5
ateb
adroddiad
0
0
Aleen Khan
Aleen Khan
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Mae gen i 300 o siapiau mewn dalen. A yw'n bosibl gwirio gwerth y gell gyfagos neu gysylltiedig (gwag neu heb fod yn wag) mewn dalen a lliwio'r siapiau cysylltiedig trwy god VBA?
ateb
0
0
Alan
Alan
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Datrysiad vba gwych.

Mae hefyd yn bosibl defnyddio fformatio amodol i liwio'r siapiau.

Gosodwch enw pob siâp fel gwerth y gell. Gan ddefnyddio Gyda Pob Siâp yna gosodwch y lliw siâp fel lliw cell ar gyfer pob siâp a enwir.

Gellir newid lliw'r gell gan ddefnyddio fformatio amodol yn seiliedig ar werthoedd rhifiadol.

Er enghraifft, gellir defnyddio lliw gorgyffwrdd lled dryloyw ar fap dinas i ddangos yn graffig ddwysedd poblogaeth fesul bloc gyda chynllun lliw graddedig.
ateb
0
0
Ed
Ed     Alan
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Allwch chi rannu enghraifft o'r cod?
ateb
0
0
Yasir
Yasir
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Sut gellir cymhwyso hyn os oes gennych chi siâp lluosog yn yr un daflen waith?
ateb
0
0
MandyZhou
MandyZhou     Yasir
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Yasir,
Falch i helpu. Copïwch a gludwch y cod VBA isod i ffenestr wag y Modiwl.

Is-brawfMacro2()
Dim dblHt Fel Dwbl
Dim rngC Fel Ystod
Dim lngr Cyhyd
Dim dblMargin Fel Dwbl
Dim lngSR Cyhyd

lngSR = 2 'Rhes lle mae'r data'n dechrau

dblMargin = 6 ' Pellter rhwng siapiau

'Ar Gwall Ailddechrau Nesaf
ActiveSheet.Shapes.SelectAll
Dewis.Dileu
Ar Gwall Ewch i 0


dblHt = Rhesi(lngSR).Uchder * 4

Ar gyfer lngr = lngSR I Gelloedd(lngSR, "A").Diwedd(xlDown).Rhes
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celloedd(lngSR, "D"). Chwith + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Celloedd(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Dewiswch
Selection.Name = "Rownd" & Celloedd(lngr, "A").Cyfeiriad
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Celloedd(lngr, "A").Value
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Diwedd Gyda
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Llenwi.Solid
.Maint = 12
Diwedd Gyda
Gyda Selection.ShapeRange.Fill
.Gweladwy = msoTrue
Os Celloedd(lngr, "A").Gwerth > 70 Yna
.ForeColor.RGB = RGB(0, 176, 80)
Celloedd Arall(lngr, "A").Gwerth >= 40 Yna
.ForeColor.RGB = RGB(255, 255, 70)
arall
.ForeColor.RGB = RGB(255, 0, 0)
Gorffennwch Os
.Tryloywder = 0
.Soled
Diwedd Gyda
Lngr nesaf
Ystod ("A1"). Dewiswch
Is-End

Ar ôl i chi redeg y cod VBA uchod, fe welwch siapiau lluosog yn cael eu cynhyrchu, ac mae lliwiau'r siapiau hyn yn cael eu newid yn ôl y VBA.
Os gwelwch yn dda weld fy screenshot. Gobeithio y gall helpu. Cael diwrnod braf.
Yn gywir,
Mandy
Gweld Atodiadau (1 / 5
ateb
adroddiad
0
0
Steve A
Steve A
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Diolch am hyn sy'n ddefnyddiol iawn.

Rwyf nawr am ei ddefnyddio gyda thabl colyn ar daflen waith arall sy'n rheoli'r data ar y daflen gyda'r siapiau rydw i eisiau newid lliw. Fodd bynnag, pan fyddaf yn newid y dewis ar y tabl colyn mae'r data ar y daflen waith gyda'r siapiau yn cael ei ddiweddaru ond nid yw'r cod yn rhedeg felly nid yw'r siapiau yn newid lliw

Os byddaf yn newid y gwerthoedd â llaw mae'r cod yn rhedeg ac mae lliw'r siapiau'n cael ei ddiweddaru.

Cwestiwn: beth sydd angen i mi ei ychwanegu at y cod uchod i ganiatáu iddo redeg yn awtomatig?
ateb
0
0
Cesare
Cesare
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Sut ydw i'n gwneud i'r is-adran breifat ddarllen canlyniad y cyfrifiad AVERAGE(C1,C5,C9)?

Mae is yn gweithio gyda gwerthoedd rhifol yn unig; gwerthfawrogir unrhyw syniadau ac awgrymiadau yn fawr.
ateb
0
0
MandyZhou
MandyZhou     Cesare
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Cesare, Sut wyt ti? Sylwaf y gall y cod VBA weithio gyda'r cyfrifiad CYFARTALEDD (rhif, rhif ...). Ond y tric yw, bob tro y byddwch chi'n newid y gwerthoedd yn y cyfrifiad, mae angen i chi glicio ddwywaith ar y fformiwla yn y gell i wneud i'r VBA weithio eto. 
Er enghraifft, Yng nghell A1, ar ôl i ni fewnbynnu'r fformiwla yw = AVERAGE(C2:D3), mae'r VBA yn gweithio ac yn newid lliw y siâp yn unol â hynny. Gweler sgrinlun 1. C0.2:D2, mae'r canlyniad a ddychwelwyd yng nghell A3 yn newid, ond nid yw lliw'r siâp wedi'i newid eto. Yn yr achos hwn, mae angen inni glicio ddwywaith ar y fformiwla yng nghell A1 i wneud i'r VBA weithio. Yna bydd lliw y siâp yn cael ei newid yn unol â hynny. Gweler sgrinluniau 1 a 2.
Gweld Atodiadau (2 / 5
ateb
adroddiad
0
0
Mark
Mark
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo... datrysiad ardderchog... ond sut ydw i'n ei gymhwyso i siapiau lluosog yn seiliedig ar werthoedd cyfatebol ystod o gelloedd. Llawer o ddiolch ymlaen llaw am eich cymorth.
ateb
adroddiad
0
0
MandyZhou
MandyZhou     Mark
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Ryan,
Falch i helpu. Copïwch a gludwch y cod VBA isod i ffenestr wag y Modiwl.

Is-brawfMacro2()
Dim dblHt Fel Dwbl
Dim rngC Fel Ystod
Dim lngr Cyhyd
Dim dblMargin Fel Dwbl
Dim lngSR Cyhyd

lngSR = 2 'Rhes lle mae'r data'n dechrau

dblMargin = 6 ' Pellter rhwng siapiau

'Ar Gwall Ailddechrau Nesaf
ActiveSheet.Shapes.SelectAll
Dewis.Dileu
Ar Gwall Ewch i 0


dblHt = Rhesi(lngSR).Uchder * 4

Ar gyfer lngr = lngSR I Gelloedd(lngSR, "A").Diwedd(xlDown).Rhes
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celloedd(lngSR, "D"). Chwith + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Celloedd(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Dewiswch
Selection.Name = "Rownd" & Celloedd(lngr, "A").Cyfeiriad
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Celloedd(lngr, "A").Value
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Diwedd Gyda
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Llenwi.Solid
.Maint = 12
Diwedd Gyda
Gyda Selection.ShapeRange.Fill
.Gweladwy = msoTrue
Os Celloedd(lngr, "A").Gwerth > 70 Yna
.ForeColor.RGB = RGB(0, 176, 80)
Celloedd Arall(lngr, "A").Gwerth >= 40 Yna
.ForeColor.RGB = RGB(255, 255, 70)
arall
.ForeColor.RGB = RGB(255, 0, 0)
Gorffennwch Os
.Tryloywder = 0
.Soled
Diwedd Gyda
Lngr nesaf
Ystod ("A1"). Dewiswch
Is-End

Ar ôl i chi redeg y cod VBA uchod, fe welwch siapiau lluosog yn cael eu cynhyrchu, ac mae lliwiau'r siapiau hyn yn cael eu newid yn ôl y VBA.
Os gwelwch yn dda weld fy screenshot. Gobeithio y gall helpu. Cael diwrnod braf.
Yn gywir,
Mandy
Gweld Atodiadau (1 / 5
ateb
adroddiad
0
0
María Noel
María Noel
Lleihawyd y sylw hwn gan y safonwr ar y wefan
¿Cómo hacemos si tenemos o 1 Oval a lliw o liwiau cambian de acuerdo con el valor ingresado, ar ffurf enghreifftiau, yn A1, B1, C1...? Mil gracias por su ayuda!

ateb
0
0
MandyZhou
MandyZhou     María Noel
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo María Noel,
Falch i helpu. Copïwch a gludwch y cod VBA isod i ffenestr wag y Modiwl.

Is-brawfMacro2()
Dim dblHt Fel Dwbl
Dim rngC Fel Ystod
Dim lngr Cyhyd
Dim dblMargin Fel Dwbl
Dim lngSR Cyhyd

lngSR = 2 'Rhes lle mae'r data'n dechrau

dblMargin = 6 ' Pellter rhwng siapiau

'Ar Gwall Ailddechrau Nesaf
ActiveSheet.Shapes.SelectAll
Dewis.Dileu
Ar Gwall Ewch i 0


dblHt = Rhesi(lngSR).Uchder * 4

Ar gyfer lngr = lngSR I Gelloedd(lngSR, "A").Diwedd(xlDown).Rhes
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celloedd(lngSR, "D"). Chwith + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Celloedd(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Dewiswch
Selection.Name = "Rownd" & Celloedd(lngr, "A").Cyfeiriad
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Celloedd(lngr, "A").Value
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Diwedd Gyda
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Llenwi.Solid
.Maint = 12
Diwedd Gyda
Gyda Selection.ShapeRange.Fill
.Gweladwy = msoTrue
Os Celloedd(lngr, "A").Gwerth > 70 Yna
.ForeColor.RGB = RGB(0, 176, 80)
Celloedd Arall(lngr, "A").Gwerth >= 40 Yna
.ForeColor.RGB = RGB(255, 255, 70)
arall
.ForeColor.RGB = RGB(255, 0, 0)
Gorffennwch Os
.Tryloywder = 0
.Soled
Diwedd Gyda
Lngr nesaf
Ystod ("A1"). Dewiswch
Is-End

Ar ôl i chi redeg y cod VBA uchod, fe welwch siapiau lluosog yn cael eu cynhyrchu, ac mae lliwiau'r siapiau hyn yn cael eu newid yn ôl y VBA.
Os gwelwch yn dda weld fy screenshot. Gobeithio y gall helpu. Cael diwrnod braf.
Yn gywir,
Mandy
Gweld Atodiadau (1 / 5
ateb
adroddiad
0
0
mnsosa
mnsosa
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Datrysiad gwych! Sut alla i wneud os oes gen i fwy nag 1 hirgrwn yn y daflen waith y mae'r lliwiau'n newid yn ôl y mewnbwn gwerth dyweder yn A1, B1, C1? Diolch ymlaen llaw am eich ateb! 
ateb
adroddiad
1
0
MandyZhou
MandyZhou     mnsosa
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo mnsosa, Falch helpu. Copïwch a gludwch y cod VBA isod i ffenestr wag y Modiwl.
Is-brawfMacro2()
Dim dblHt Fel Dwbl
Dim rngC Fel Ystod
Dim lngr Cyhyd
Dim dblMargin Fel Dwbl
Dim lngSR Cyhyd

lngSR = 2 'Rhes lle mae'r data'n dechrau

dblMargin = 6 ' Pellter rhwng siapiau

'Ar Gwall Ailddechrau Nesaf
ActiveSheet.Shapes.SelectAll
Dewis.Dileu
Ar Gwall Ewch i 0


dblHt = Rhesi(lngSR).Uchder * 4

Ar gyfer lngr = lngSR I Gelloedd(lngSR, "A").Diwedd(xlDown).Rhes
ActiveSheet.Shapes.AddShape(msoShapeOval, _
Celloedd(lngSR, "D"). Chwith + ((lngr - lngSR) Mod 4) * dblHt + dblMargin, _
Celloedd(lngSR, "D").Top + Int((lngr - lngSR) / 4) * dblHt + dblMargin, _
dblHt - 2 * dblMargin, _
dblHt - 2 * dblMargin).Dewiswch
Selection.Name = "Rownd" & Celloedd(lngr, "A").Cyfeiriad
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Celloedd(lngr, "A").Value
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignCenter
Diwedd Gyda
Gyda Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 2).Font
.Bold = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.Fill.ForeColor.TintAndShade = 0
.Fill.ForeColor.Brightness = 0
.Fill.Transparency = 0
.Llenwi.Solid
.Maint = 12
Diwedd Gyda
Gyda Selection.ShapeRange.Fill
.Gweladwy = msoTrue
Os Celloedd(lngr, "A").Gwerth > 70 Yna
.ForeColor.RGB = RGB(0, 176, 80)
Celloedd Arall(lngr, "A").Gwerth >= 40 Yna
.ForeColor.RGB = RGB(255, 255, 70)
arall
.ForeColor.RGB = RGB(255, 0, 0)
Gorffennwch Os
.Tryloywder = 0
.Soled
Diwedd Gyda
Lngr nesaf
Ystod ("A1"). Dewiswch
Is-End

Ar ôl i chi redeg y cod VBA uchod, fe welwch siapiau lluosog yn cael eu cynhyrchu, a lliwiau'r siapiau hyn yn cael eu newid yn ôl y VBA.Please gwelwch fy screenshot. Gobeithio y gall helpu. Cael diwrnod braf.Yn gywir, Mandy
Gweld Atodiadau (1 / 5
ateb
adroddiad
0
0
Max
Max
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Rwy'n newydd i VBAs ac rwy'n cael trafferth gyda rhywbeth. Mae angen i mi gael 9 cell gwahanol A1-A9 newid lliw 9 gwrthrych gwahanol. Gwrthrychau yw ciwbiau 1-9. Dim ond i egluro, mae pob cell i newid dim ond un gwrthrych A1-Cube 1, ac ati Coch os yw'n methu â bodloni'r gwerth a gwyrdd os yw'n fwy na'r gwerth. Gall y gwerth pasio/methu newid felly yn lle cael y gwerth yn y VBA mae angen imi gyfeirio at gell A10 sydd â'r gwerth pasio/methu. Unrhyw siawns y gallai rhywun drwy allan cod sampl i mi weithio gyda.

diolch
ateb
0
0
Roberto tovar
Roberto tovar
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, esiampl ardderchog.
Pero como seria si tengo una forma y quiero ir coloreado poco a poco dependiendo del valor ejemplo:
50%
Seia mitad roja y mitad verde
Pero que se vaya llenando según el porcentaje vaya aumentando
ateb
0
0
Wedi graddio 4 allan o 5
emilly
emilly
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Como faço para para variar as cores da forma se minha opções for em formato de texto, mar "Sim" a "Não"?
ateb
0
0
skyyang
skyyang     emilly
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo, Emily
I ddatrys eich problem, defnyddiwch y cod isod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") = "Yes" Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
Else
If Range("A1") = "No" Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub


Rhowch gynnig arni, gobeithio y gall eich helpu!
ateb
adroddiad
0
0
Neil
Neil     skyyang
Lleihawyd y sylw hwn gan y safonwr ar y wefan
Helo Skyyang,

Ceisiais y cod VBA gwreiddiol a'i gael i weithio, er na fyddai'n actifadu'n weithredol pan newidiodd y gell. Heddiw nid yw'r cod yn gweithio a rhoddais gynnig ar eich cod mwy syml hefyd ac nid oedd yn gweithio o hyd. Yr unig beth a newidiodd yw fy mod wedi copïo'r daflen waith a oedd yn cynnwys y cod a weithiodd. A fyddai hyn wedyn yn golygu na fyddai'n gweithio?
ateb
0
0
Nid oes unrhyw sylwadau wedi'u postio yma eto
Gadewch eich sylwadau
Guest
Postio fel Gwestai
Mewngofnodi
×
Graddiwch y swydd hon:
Ailosod
0   Cymeriadau
Lleoliadau a Awgrymir

Dilynwch ni

Hawlfraint © 2009 - www.extendoffice.com. | Cedwir pob hawl. Wedi ei bweru gan ExtendOffice. | Map o'r safle
Mae Microsoft a logo'r Swyddfa yn nodau masnach neu'n nodau masnach cofrestredig Microsoft Corporation yn yr Unol Daleithiau a / neu wledydd eraill.
Wedi'i warchod gan Sectigo SSL