Sub 樹狀圖()
Dim x, yx = 300y = 150
d = 0
d1 = x
For j = 2 To 5
For i = 2 To 5
w = (Cells(6, j).Value * 100) * 2.84
h = (Cells(i, j).Value / Cells(6, j).Value) * 100 * 2.84
If i = 2 Then
d = y
Else
d = d + (Cells(i - 1, j).Value / Cells(6, j).Value) * 100 * 2.84
End If
Cells(i, 9) = h
Cells(i, 10) = d1
ActiveSheet.Shapes.AddShape(msoShapeRectangle, d1, d, w, h).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Cells(i, 1).Value & " , " & Cells(i, 2) * 100 & "%"
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(22 * i, 33 * j, 122 + i + j)
.Transparency = 0
.Solid
End With
Next
d1 = d1 + w
Next
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Cut
ActiveSheet.PasteSpecial Format:="圖片 (PNG) ", Link:=False, DisplayAsIcon _
:=False
End Sub
