第十四章 圖案

第十四章　圖案
14-01　建立線條

應用範例
Sub 建立線條()
MsgBox “在使用中工作表內建立一條起點為(10,10)、終點為(250,100)的線條”
ActiveSheet.Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=250, EndY:=100).Select
End Sub

14-02　建立三角形

應用範例
Sub 建立三角形()
MsgBox “在使用中工作表內建立一個左上角位於(70,40)、寬度為130點、高度為72點的三角形”
ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, Left:=70, Top:=40, Width:=130, Height:=72).Select
End Sub

14-03　建立矩形

應用範例
Sub 建立矩形()
MsgBox “在使用中工作表內建立一個左上角位於(70,40)、寬度為130點、高度為72點的矩形”
ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=70, Top:=40, Width:=130, Height:=72).Select
End Sub

14-04　建立圓形或橢圓形

應用範例
Sub 建立橢圓形()
MsgBox “在使用中工作表內建立一個左上角位於(70,40)、寬度為130點、高度為72點的橢圓形”
ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, Left:=70, Top:=40, Width:=130, Height:=72).Select
End Sub

14-05　刪除圖案

應用範例
Sub 刪除圖案()
MsgBox “刪除使用中工作表內第一個圖案”
ActiveSheet.Shapes(1).Delete
End Sub

14-06　計算圖案的數量

應用範例
Sub 計算圖案的數量()
MsgBox “顯示使用中工作表中圖案的數量”
MsgBox ActiveSheet.Shapes.Count
End Sub

14-07　選取圖案

應用範例
Sub 選取圖案()
MsgBox “輸入號碼來選取圖案”
suu = ActiveSheet.Shapes.Count
zbangou = InputBox(“圖案的數量為：” & suu & “個，請輸入1到” & suu & “的數字來選取圖案”)
MsgBox “您選取了使用中工作表內第 ” & zbangou & “ 個圖案”
zbangou = CInt(zbangou)
ActiveSheet.Shapes(zbangou).Select
End Sub
14-08　移動圖案

應用範例
Sub 移動圖案()
MsgBox “將被選取的圖案向右移動200點、向下移動40點”
With Selection.ShapeRange
.IncrementLeft 200
.IncrementTop 40
End With
End Sub

14-09　隱藏圖案

應用範例
Sub 隱藏圖案()
bangou = 1
MsgBox “隱藏使用中工作表內第 ” & bangou & “ 個圖案”
ActiveSheet.Shapes(bangou).Visible = False
MsgBox “回復原來的狀態”
ActiveSheet.Shapes(bangou).Visible = True
End Sub

14-10　變更圖案線條的粗細

應用範例
Sub 變更圖案線條的粗細()
MsgBox “將第一個圖案的線條設為粗線”
ActiveSheet.Shapes(1).Line.Weight = xlThick……1
End Sub

14-11　變更圖案線條的虛線樣式

應用範例
Sub 設定圖案虛線的樣式()
MsgBox “將第一個圖案的線條變更為方形點線”
ActiveSheet.Shapes(1).Select
sensyu = Selection.ShapeRange.Line.DashStyle
Selection.ShapeRange.Line.DashStyle = msoLineSquareDot
MsgBox “回復原來的狀態”
Selection.ShapeRange.Line.DashStyle = sensyu
End Sub

14-12　變更圖案線條的顏色

應用範例
Sub 變更圖案線條的顏色()
i = 2
MsgBox “將使用中工作表內第 ” & i & “ 個圖案的線條顏色變更為藍色”
ActiveSheet.Shapes(i).Line.ForeColor.RGB = RGB(0,0,255)
MsgBox “回復原來的狀態”
ActiveSheet.Shapes(i).Line.ForeColor.RGB = RGB(0,0,0)
End Sub

14-13　設定圖案的前景色及背景色

應用範例
Sub 設定圖案的前景色()
MsgBox “將使用中工作表內第二個圖案的前景色設為紅色”
ActiveSheet.Shapes(2).Fill.Forecolor.RGB = RGB(255,0,0)
End Sub

14-14　圖案的旋轉

應用範例
Sub 旋轉圖案()
MsgBox “將使用中工作表內第一個圖案旋轉20度”
ActiveSheet.Shapes(1).Rotation = 20……1
End Sub
14-15　圖案的翻轉

應用範例1
Sub 將圖案水平翻轉()
MsgBox “水平翻轉使用中圖表內第一個圖案”
ActiveSheet.Shapes(1).Select
Selection.ShapeRange.Flip msoFlipHorizontal
End Sub

應用範例2
Sub 將圖案垂直翻轉()
MsgBox “垂直翻轉使用中圖表內第一個圖案”
ActiveSheet.Shapes(1).Select
Selection.ShapeRange.Flip msoFlipVertical
End Sub

14-16　設定圖案的顏色

應用範例
Sub 設定圖案的顏色()
MsgBox “將使用中圖表的第一個圖案顏色設為黃色”
ActiveSheet.Shapes(1).Fill.ForeColor.SchemeColor = 13
End Sub

14-17　圖案的漸層色

應用範例1
Sub 圖案的漸層色1()
MsgBox “依序顯示單色漸層的六種漸層樣式”
For syurui = 1 To 6
ActiveSheet.Shapes(1).Fill.OneColorGradient syurui, 4, 0.3
MsgBox “第 ” & syurui & “ 種漸層樣式”
Next syurui
End Sub

應用範例2
Sub 圖案的漸層色2()
MsgBox “依序顯示雙色漸層的四種變化”
ActiveSheet.Shapes(1).Fill.ForeColor.SchemeColor = 13
For i = 1 To 4
ActiveSheet.Shapes(1).Fill.TwoColorGradient msoGradientHorizontal, i
MsgBox “第 ” & i & “ 種漸層變化”
Next i
End Sub

14-18　圖案的超連結

應用範例
Sub 設定圖型的超連結()
MsgBox “在使用中工作表內第一個圖案中建立超連結”
fname = “Y:\成績一覽表.xls”……1
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(1), Address:=fname
End Sub

14-19　建立立體圖案

應用範例1
Sub 建立立體圖案()
MsgBox “將所選取的圖案設為第一種立體樣式的圖案”
Selection.ShapeRange.ThreeD.SetThreeDFormat msoThreeD1
End Sub

應用範例2
Sub 顯示立體圖案的立體樣式()
MsgBox “在被選取的立體圖案上依序顯示立體樣式”
For i = 1 To 20
Selection.ShapeRange.ThreeD.SetThreeDFormat i
henji = MsgBox(“第 ” & i & “種立體樣式，是否繼續？”, vbYesNo)
If henji = vbNo Then Exit Sub
Next i
End Sub

14-20　變更立體圖案的深度

應用範例
Sub 設定立體圖案的深度()
MsgBox “將使用中工作表內第一個立體圖案的深度設為70點”
okuyuki = 70
ActiveSheet.Shapes(1).ThreeD.Depth = okuyuki
End Sub

14-21　變更立體圖案深度部份的顏色

應用範例
Sub 變更立體圖案深度部份的顏色()
MsgBox “將使用中工作表內第一個立體圖案深度部份的顏色設為藍色”
ActiveSHeet.Shapes(1).ThreeD.ExtrusionColor.RGB = RGB(0,0,255)
End Sub

14-22　旋轉立體圖案

應用範例1
Sub 設定立體圖案的X軸旋轉角度()
kakudo = 60
MsgBox “將立體圖案繞X軸旋轉 ” & kakudo & “ 度”
ActiveSheet.Shapes(1).ThreeD.RotationX = kakudo
End Sub

應用範例2
Sub 設定立體圖案的Y軸旋轉角度()
kakudo = 30
MsgBox “將立體圖案繞Y軸旋轉 ” & kakudo & “ 度”
ActiveSheet.Shapes(1).ThreeD.RotationY = kakudo
End Sub

應用範例3
Sub 設定立體圖案的X、Y軸旋轉角度()
kakudox = 60
kakudoy = 30
MsgBox “將立體圖案繞X軸旋轉 ” & kakudox & “ 度、繞Y軸旋轉 ” & kakudoy & “ 度”
ActiveSheet.Shapes(1).ThreeD.RotationX = kakudox
ActiveSheet.Shapes(1).ThreeD.RotationY = kakudoy
End Sub

14-23　設定立體圖案的材質

應用範例
Sub 設定立體圖案的材質()
MsgBox “依序變更使用中工作表內第一個立體圖案的材質”
For i = 1 To 4
ActiveSheet.Shapes(1).ThreeD.PresetMaterial = i
MsgBox “目前的材質常數值為：” & i
Next i
End Sub

14-24　將立體圖案變更為平面圖案

應用範例
Sub 將立體圖案變更為平面圖案()
MsgBox “將所選取的立體圖案變更為平面圖案”
Selection.ShapeRange.ThreeD.Visible = msoFalse
End Sub

14-25　建立文字藝術師

應用範例
Sub 建立文字藝術師()
MsgBox “在座標(50,100)處建立文字藝術師，並選取它”
ActiveSheet.Shapes.AddTextEffect(PresetTextEffect:=msoTextffect1, Text:=“Excel VBA”, FontName:=“Cooper Black”, FontSize:=44, FontBold:=True, FontItalic:=False, Left:=100, Top:=50).Select
End Sub

14-26　文字藝術師的形狀

應用範例
Sub 設定文字藝術師圖案()
MsgBox “依序顯示使用中工作表內第一個圖案的文字藝術師圖案”
For i =1 To 40
ActiveSheet.Shapes(1).TextEffect.PresetShape = i
henji = MsgBox (“目前文字藝術師圖案的常數值：” & i & “，要繼續嗎？”, vbYesNo)
If henji = vbNo Then Exit Sub
Next i
End Sub

14-27　文字藝術師圖庫

應用範例
Sub 設定文字藝術師樣式()
sutairu = 14
MsgBox “第 ” & sutairu & “ 種文字藝術師樣式”
ActiveSheet.Shapes(1).TextEffect.PresetTextEffect = sutairu
End Sub

14-28　文字藝術師的字體

應用範例
Sub 設定文字藝術師的斜體字()
MsgBox “將使用中工作表內第一個圖形的文字藝術師字體設為斜體”
ActiveSheet.Shapes(1).TextEffect.FontItalic = True
End Sub

14-29　文字藝術師的文字大小

應用範例
Sub 調整文字藝術師的大小()
MsgBox “將使用中工作表內第一個圖案放大1.2倍”
ritu = 1.2
With ActiveSheet.shapes(1)
.ScaleHeight ritu, False
.ScaleWidth ritu, False
End With
End Sub

14-30　文字藝術師的文字排列方向

應用範例
Sub 變更文字藝術師的文字排列方向()
MsgBox “變更使用中工作表內第一個圖案的文字排列方向”
ActiveSheet.Shapes(1).TextEffect.ToggleVerticalText
End Sub