根据单元格值在Excel中更改弧长 [英] Changing arc length in excel based on a cell value
问题描述
我想根据单元格值动态更改Excel中的弧长. 例如，如果像元值= 100％，则圆弧应成为一个完整的圆.如果该值= 0，它将消失. 我在下面的代码中更改了形状的大小，但我不知道如何修改形状以更改长度.
示例:
非常感谢您的帮助.
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 = "CT15" Then
Call SizeCircle("Block Arc 63", 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
您可以使用Shapes.Adjustments属性来调整块弧的长度".
过程AdjustArc会将指定的形状设置为指定的"完成百分比".
过程Demo将动画化"形状的进度.在运行演示之前，请确保根据需要更改图纸名称和形状名称.步骤Pause仅用于Demo.
Sub AdjustArc(arcShape As Shape, percent As Single)
'adjust the circumference of the arc or hides if 0%.
'Supply the percent as a fraction between 0 and 1. (50% = 0.5)
With arcShape
If percent <= 0 Then 'hide shape
.Visible = False
Exit Sub
End If
If percent > 1 Then percent = 1 'over 100%, make it 100%
.Visible = True
'0 = Full Circle, 359.9 = sliver, 360 = Full Circle
.Adjustments.Item(1) = (1 - percent) * 359.9
End With
End Sub
Sub demo() 'Run this one for demonstration
Dim ws As Worksheet, sh As Shape, x As Single
Set ws = ThisWorkbook.Sheets("Sheet1")
Set sh = ws.Shapes("Block Arc 1")
For x = 0 To 1 Step 0.005
AdjustArc sh, x
Pause 0.01
Next x
End Sub
Sub Pause(seconds As Single) 'just for the demo
'pause for specified number of seconds
Dim startTime As Single: startTime = Timer
Do: DoEvents: Loop Until Timer >= startTime + seconds
End Sub
短版:
更改形状的线是:
ActiveSheet.Shapes("YourShapeName").Adjustments.Item(1) = x
...其中x是值> 0 and < 360.
适应您的代码
当前，当工作表的单元格CT15更改时，示例代码将调用SizeCircle.
您可以替换以下行:
Call SizeCircle("Block Arc 63", Val(Target.Value))
...与此一起:
AdjustArc ThisWorkbook.Sheets("Sheet1").Shapes("Block Arc 63"),Val(Target.Value)
只需将Sheet1替换为具有形状的工作表的名称即可.
这是假设百分比被存储为 在CT15中的实际百分比(从0到1)...格式设置无关紧要.
您的代码和我的SizeCircle过程应位于工作表模块中(因为它具有on_change事件)，您可以通过右键单击工作表的选项卡并单击View Code来打开它.
更多信息:
- MSDN: 调整对象 (Excel)
- 堆栈溢出: 关于形状的很多(我的回答)
- 代码VBA: 如何使用Excel类Shape
- MSDN: 形状对象 (Excel)
I want to dynamically change the Arc Length in Excel based on cell value. For example, if the cell value = 100%, the arch should become a complete circle. If the value = 0, it should disappear. I found below code that change the SIZE of the shape, but I don't know how to modify it to change the length.
Example:
Your help is much appreciated.
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 = "CT15" Then
Call SizeCircle("Block Arc 63", 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
You can use the Shapes.Adjustments property to adjust the "length" of the block arc.
Procedure AdjustArc will set the specified shape to the specified "% complete".
Procedure Demo will "animate" the progress in your shape. Make sure to change the Sheet name and Shape name as necessary before running the demo. Procedure Pause is only cosmetic for Demo.
Sub AdjustArc(arcShape As Shape, percent As Single)
'adjust the circumference of the arc or hides if 0%.
'Supply the percent as a fraction between 0 and 1. (50% = 0.5)
With arcShape
If percent <= 0 Then 'hide shape
.Visible = False
Exit Sub
End If
If percent > 1 Then percent = 1 'over 100%, make it 100%
.Visible = True
'0 = Full Circle, 359.9 = sliver, 360 = Full Circle
.Adjustments.Item(1) = (1 - percent) * 359.9
End With
End Sub
Sub demo() 'Run this one for demonstration
Dim ws As Worksheet, sh As Shape, x As Single
Set ws = ThisWorkbook.Sheets("Sheet1")
Set sh = ws.Shapes("Block Arc 1")
For x = 0 To 1 Step 0.005
AdjustArc sh, x
Pause 0.01
Next x
End Sub
Sub Pause(seconds As Single) 'just for the demo
'pause for specified number of seconds
Dim startTime As Single: startTime = Timer
Do: DoEvents: Loop Until Timer >= startTime + seconds
End Sub
Short Version:
The line that changes the shape is:
ActiveSheet.Shapes("YourShapeName").Adjustments.Item(1) = x
...where x is a value > 0 and < 360.
Edit: Adapting to your code
Currently your example code calls SizeCircle when cell CT15 of the worksheet changes.
You can replace this line:
Call SizeCircle("Block Arc 63", Val(Target.Value))
...with this one:
AdjustArc ThisWorkbook.Sheets("Sheet1").Shapes("Block Arc 63"),Val(Target.Value)
Just replace Sheet1 with the name of the worksheet which has the shape.
This is assuming the percentage is stored as an actual percentage (0 to 1) in CT15 ...how it's formatted doens't matter.
Your code and my SizeCircle procedure should be in the Worksheet module (since it has an on_change event) which you open by right-clicking the worksheet's tab and clicking View Code.
More Information:
- MSDN : Adjustments Object (Excel)
- Stack Overflow : Lots about Shapes (my answer)
- Code VBA : How to use Excel class Shape
- MSDN : Shape Object (Excel)
这篇关于根据单元格值在Excel中更改弧长的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
