Public dashstyle(2) As Integer
Public ForeColor_ObjectThemeColor(2) As Integer
Public ForeColor_TintAndShade(2) As Integer
Public ForeColor_Brightness(2) As Integer
Public Transparency(2) As Integer
Public Weight(2) As Integer
Public Style(2) As Integer
Public BeginArrowheadStyle(2) As Integer
Public EndArrowheadStyle(2) As Integer
Public BeginArrowheadLength(2) As Integer
Public EndArrowheadLength(2) As Integer
Public BeginArrowheadWidth(2) As Integer
Public EndArrowheadWidth(2) As Integer
Public specified As Boolean
Sub main()
If 線保存(0) Then
'If specified Then
'Call 線変更
'Else
Call 線変更
'End If
End If
End Sub
Function 線指定()
specified = 線保存(1)
End Function
Public Function 線保存(ByVal i As Integer) As Boolean
Dim shp As ShapeRange
'On Error GoTo ERR_HNDL
Set shp = Selection.ShapeRange
If 線判定(shp) Then
With shp.Line
dashstyle(i) = .dashstyle
Transparency(i) = .Transparency
Weight(i) = .Weight
Style(i) = .Style
BeginArrowheadStyle(i) = .BeginArrowheadStyle
EndArrowheadStyle(i) = .EndArrowheadStyle
BeginArrowheadLength(i) = .BeginArrowheadLength
EndArrowheadLength(i) = .EndArrowheadLength
BeginArrowheadWidth(i) = .BeginArrowheadWidth
EndArrowheadWidth(i) = .EndArrowheadWidth
ForeColor_ObjectThemeColor(i) = .ForeColor.ObjectThemeColor
ForeColor_TintAndShade(i) = .ForeColor.TintAndShade
ForeColor_Brightness(i) = .ForeColor.Brightness
End With
線保存 = True
Exit Function
End If
ERR_HNDL:
線保存 = False
End Function
Public Function 線判定(ByRef shp As ShapeRange) As Boolean
With shp
If .Count > 1 Then
MsgBox "一つだけ選択してください。"
線判定 = False
Exit Function
End If
If InStr(.Name, "Connector") = 0 Then
MsgBox "線を選択してください。"
線判定 = False
Exit Function
End If
End With
線判定 = True
End Function
Public Function 線変更()
Dim shp As Shape
'On Error GoTo ERR_HNDL
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Connector") <> 0 Then
Call 線設定(shp)
Else
Debug.Print shp.Type
End If
Next
Exit Function
ERR_HNDL:
End Function
Public Function 線設定(ByRef shp As Shape)
With shp.Line
Debug.Print shp.Name
.dashstyle = dashstyle(0)
.Transparency = Transparency(0)
.Weight = Weight(0)
.Style = Style(0)
.BeginArrowheadStyle = BeginArrowheadStyle(0)
.EndArrowheadStyle = EndArrowheadStyle(0)
.BeginArrowheadLength = BeginArrowheadLength(0)
.EndArrowheadLength = EndArrowheadLength(0)
.BeginArrowheadWidth = BeginArrowheadWidth(0)
.EndArrowheadWidth = EndArrowheadWidth(0)
.ForeColor.ObjectThemeColor = ForeColor_ObjectThemeColor(0)
.ForeColor.TintAndShade = ForeColor_TintAndShade(0)
.ForeColor.Brightness = ForeColor_Brightness(0)
End With
End Function
##参考
https://www.relief.jp/docs/018476.html
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1151038036
https://www.relief.jp/docs/excel-vba-get-name-selected-shapes.html
https://oshiete.goo.ne.jp/qa/3921059.html