図形
余白なし
余白なし
Sub 図形_余白なし()
If Selection.ShapeRange.TextFrame2.MarginLeft = 0 Then
Selection.ShapeRange.TextFrame2.MarginLeft = Application.CentimetersToPoints(0.25) Selection.ShapeRange.TextFrame2.MarginRight = 0 Selection.ShapeRange.TextFrame2.MarginTop = 0 Selection.ShapeRange.TextFrame2.MarginBottom = 0
Else
Selection.ShapeRange.TextFrame2.MarginLeft = 0 Selection.ShapeRange.TextFrame2.MarginRight = 0 Selection.ShapeRange.TextFrame2.MarginTop = 0 Selection.ShapeRange.TextFrame2.MarginBottom = 0
End If
End Sub
If Selection.ShapeRange.TextFrame2.MarginLeft = 0 Then
Selection.ShapeRange.TextFrame2.MarginLeft = Application.CentimetersToPoints(0.25) Selection.ShapeRange.TextFrame2.MarginRight = 0 Selection.ShapeRange.TextFrame2.MarginTop = 0 Selection.ShapeRange.TextFrame2.MarginBottom = 0
Else
Selection.ShapeRange.TextFrame2.MarginLeft = 0 Selection.ShapeRange.TextFrame2.MarginRight = 0 Selection.ShapeRange.TextFrame2.MarginTop = 0 Selection.ShapeRange.TextFrame2.MarginBottom = 0
End If
End Sub
枠線
枠線
Sub 図形_枠線()
'図形の枠線の表示、非表示 v1 If Selection.ShapeRange.Line.Visible = msoFalse Then Selection.ShapeRange.Line.Visible = msoTrue With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 '黒 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Weight = 0.25 End With With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With On Error Resume Next With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 .Solid End With On Error GoTo 0 ElseIf Selection.ShapeRange.Line.ForeColor.RGB <> RGB(255, 0, 0) Then '赤 Selection.ShapeRange.Fill.Visible = msoFalse With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) '赤 .Transparency = 0 .Weight = 2.25 End With Else Selection.ShapeRange.Line.Visible = msoFalse End If End Sub
'図形の枠線の表示、非表示 v1 If Selection.ShapeRange.Line.Visible = msoFalse Then Selection.ShapeRange.Line.Visible = msoTrue With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 '黒 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Weight = 0.25 End With With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With On Error Resume Next With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 .Solid End With On Error GoTo 0 ElseIf Selection.ShapeRange.Line.ForeColor.RGB <> RGB(255, 0, 0) Then '赤 Selection.ShapeRange.Fill.Visible = msoFalse With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) '赤 .Transparency = 0 .Weight = 2.25 End With Else Selection.ShapeRange.Line.Visible = msoFalse End If End Sub
塗りつぶし
塗りつぶし
Sub 図形_塗りつぶし()
'図形の塗りつぶしを自動設定 On Error Resume Next With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Weight = 0.25 End With
If Selection.ShapeRange.Fill.Visible <> msoTrue Then
If Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1 Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 255, 0) '黄 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0) Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) '赤 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0) Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 176, 240) '青 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 240) Then Selection.ShapeRange.Fill.Visible = msoFalse '透明 With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With End If Else With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With End If Selection.ShapeRange.SetShapesDefaultProperties
On Error GoTo 0
End Sub
'図形の塗りつぶしを自動設定 On Error Resume Next With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorText1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Weight = 0.25 End With
If Selection.ShapeRange.Fill.Visible <> msoTrue Then
If Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1 Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 255, 0) '黄 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0) Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) '赤 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0) Then With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 176, 240) '青 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With ElseIf Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 176, 240) Then Selection.ShapeRange.Fill.Visible = msoFalse '透明 With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With End If Else With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 '白 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) '黒 .Transparency = 0 .Solid End With End If Selection.ShapeRange.SetShapesDefaultProperties
On Error GoTo 0
End Sub
赤矢印
赤矢印
Sub 図形_赤矢印()
'矢印を赤太線にする With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 .Weight = 6 End With
Selection.ShapeRange.SetShapesDefaultProperties
End Sub
'矢印を赤太線にする With Selection.ShapeRange.Line .Visible = msoTrue .ForeColor.RGB = RGB(255, 0, 0) .Transparency = 0 .Weight = 6 End With
Selection.ShapeRange.SetShapesDefaultProperties
End Sub
張替え
張替え
Sub 図形_張替え()
'図形を張り替える
Dim x As Single Dim y As Single Dim w As Single Dim z As Single
x = Selection.Top y = Selection.Left w = Selection.Width
Selection.Delete Cells(1, 1).Select ActiveSheet.Paste Selection.Top = x Selection.Left = y Selection.Width = w Selection.ShapeRange.ZOrder msoSendToBack
End Sub
'図形を張り替える
Dim x As Single Dim y As Single Dim w As Single Dim z As Single
x = Selection.Top y = Selection.Left w = Selection.Width
Selection.Delete Cells(1, 1).Select ActiveSheet.Paste Selection.Top = x Selection.Left = y Selection.Width = w Selection.ShapeRange.ZOrder msoSendToBack
End Sub
コメントのサイズ自動調整
コメントのサイズ自動調整
Sub 図形_コメントのサイズ自動調整()
'選択したセルのコメントのサイズを自動調整する。
ActiveCell.Comment.Shape.TextFrame.AutoSize = True
End Sub
'選択したセルのコメントのサイズを自動調整する。
ActiveCell.Comment.Shape.TextFrame.AutoSize = True
End Sub
サイズ自動調整
サイズ自動調整
Sub 図形_サイズ自動調整()
'選択した図形のサイズを自動調整する。
Selection.ShapeRange.TextFrame.AutoSize = True
End Sub
'選択した図形のサイズを自動調整する。
Selection.ShapeRange.TextFrame.AutoSize = True
End Sub
サイズ縮小
サイズ縮小
Sub 図形_サイズ縮小() '図形のサイズを75%、50%、25%にする。 Dim w_width As Single Dim w_width75 As Single Dim w_width50 As Single Dim w_width25 As Single On Error Resume Next With Selection.ShapeRange If Err.Number <> 0 Then MsgBox "図形が選択されていません。" On Error GoTo 0 Exit Sub End If w_width = .Width .LockAspectRatio = True .ScaleWidth 0.75, msoTrue, msoScaleFromTopLeft w_width75 = .Width .ScaleWidth 0.5, msoTrue, msoScaleFromTopLeft w_width50 = .Width .ScaleWidth 0.25, msoTrue, msoScaleFromTopLeft w_width25 = .Width If w_width <= w_width25 Then .ScaleWidth 1, msoTrue, msoScaleFromTopLeft ElseIf w_width <= w_width50 Then .ScaleWidth 0.25, msoTrue, msoScaleFromTopLeft ElseIf w_width <= w_width75 Then .ScaleWidth 0.5, msoTrue, msoScaleFromTopLeft Else .ScaleWidth 0.75, msoTrue, msoScaleFromTopLeft End If End With On Error GoTo 0 End Sub