2003では、ShapeのFillFormat[塗りつぶし効果]-[グラデーション]タブに「図形に合わせて塗りつぶしを回転する」チェックボックスがあります。
これは手作業で[グラデーション]を設定すると、ONが既定のようで、自動的にチェックが付きます。
ところがVBAから設定すると、OFFのままなんですね。
Sub test()
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100) _
.Fill.OneColorGradient msoGradientHorizontal, 1, 0
End Sub
FillFormatのプロパティを探っても、それらしきものが無いようです。非表示メンバにも見当たりません。
コードからのアクセスが許可されていない、もしくは公開されていないという事でしょうか。
Shapeごとに設定が保存されている事は確かなんですが。
...という事で、無理矢理設定してみます。
かなりのムリすぎ...orz
Option Explicit
Sub try()
Dim sp As Shape
Application.ScreenUpdating = False
Set sp = fRotateShape(ActiveSheet, msoShapeRectangle)
With sp
.Left = 100
.Top = 100
.Width = 100
.Height = 100
'.Fill.OneColorGradient msoGradientVertical, 1, 0
End With
Set sp = Nothing
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------
Function fRotateShape(ByRef ws As Worksheet, _
ByVal sType As Long) As Shape
Dim wrk As String
Dim tmp As String
Dim n As Long
wrk = Application.DefaultFilePath & "¥rotatetemp.htm"
Application.ScreenUpdating = False
With Workbooks.Add(xlWBATWorksheet)
.Sheets(1).Shapes.AddShape(sType, 0, 0, 0, 0) _
.Fill.OneColorGradient msoGradientHorizontal, 1, 0
Application.DisplayAlerts = False
.SaveAs Filename:=wrk, FileFormat:=xlHtml
Application.DisplayAlerts = True
.Close False
End With
n = FreeFile
Open wrk For Input As #n
tmp = StrConv(InputB(LOF(n), #n), vbUnicode)
Close #n
tmp = Replace$(tmp, "method=", "rotate=""t"" method=")
n = FreeFile
Open wrk For Output As #n
Print #n, tmp
Close #n
With Workbooks.Open(wrk, ReadOnly:=True)
.Sheets(1).Shapes(1).Copy
.Close False
End With
With CreateObject("Scripting.FileSystemObject")
.GetFile(wrk).Delete
.GetFolder(Replace$(wrk, ".htm", ".files")).Delete
End With
With ws
.Paste
Set fRotateShape = .Shapes(.Shapes.Count)
End With
Application.ScreenUpdating = True
End Function
htmファイルに吐き出して、ShapeのFill設定にrotate="t"を追加するわけです。
<v:fill color2="fill darken(0)" rotate="t" method="linear sigma" focus="100%" type="gradient"/>
もっと簡単にできる方法があったら笑いものだよなぁ...