MW211 EXIT

devlog
ExcelVBA/画像採取
2019年02月04日
ファイルパスかURLを指定したセルを選択して実行すると
右隣りに画像が採取されるマクロ。
┌──────────────────────────────────────┐
│Public Sub 右隣に画像を採取します()                                         │
│    Dim セル As Range                                                       │
│    For Each セル In Selection                                              │
│        If セル.Value <> "" Then                                            │
│            Call 画像追加(セル)                                             │
│        End If                                                              │
│    Next セル                                                               │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Sub 画像追加(ByVal セル As Range)                                   │
│    Dim 画像 As Shape                                                       │
│    On Error GoTo l_Catch                                                   │
│    With セル                                                               │
│        Set 画像 = ActiveSheet.Shapes.AddPicture( _                         │
│            Filename:=.Value, _                                             │
│            LinkToFile:=False, _                                            │
│            SaveWithDocument:=True, _                                       │
│            Left:=.Left + .Width, _                                         │
│            Top:=.Top, _                                                    │
│            Width:=.Offset(, 1).Width, _                                    │
│            Height:=.Offset(, 1).Height _                                   │
│        )                                                                   │
│    End With                                                                │
│    Exit Sub                                                                │
│l_Catch:                                                                    │
│    セル.Offset(, 1).Value = "ファイルが見つかりません"                     │
│End Sub                                                                     │
└──────────────────────────────────────┘
分類:ExcelVBA