エクセルに詳しい方お願いします。

Visual Basic | Excel136閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

0

ThanksImg質問者からのお礼コメント

ありがとうございました。 かなり便利になりました。 ソースがわかったので アレンジしていろいろ試してみたいと思います。

お礼日時:2021/11/30 22:27

その他の回答(1件)

0

呼び出し方だけであれば、以下のようなものでしょうか? 動作確認はしていません。間違っていたらごめんなさい。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Columns.Count = 6 And Target.Rows.Count = 11 Then Call SheetShapesAssign(Target) ElseIf Target.Columns.Count = 10 And Target.Rows.Count = 16 Then Call SheetShapesAssign(Target) End If End Sub Private Sub SheetShapesAssign(ByVal Target As Range) Dim dlgAnswer As Boolean, x As Object, MyWidth As Single, MyHeight As Single Application.ScreenUpdating = False MyWidth = Target.Width - 10 MyHeight = Target.Height dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show For Each x In ActiveSheet.Shapes With x If .Width > MyWidth Then .LockAspectRatio = msoTrue .Width = MyWidth .Line.ForeColor.SchemeColor = 64 .Line.Visible = msoTrue End If End With Next Application.ScreenUpdating = True End Sub