| |
画像名の入力をリストから選択するようにしました
入力値削除で、元の位置に戻せるようにしました
Option Explicit
Const myAdr As String = "A1:A10"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim p As Picture
Dim s As String
Dim c As Range
Dim v
Set r = Range(myAdr)
If Intersect(Target, r) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
'
On Error Resume Next
Set p = Pictures(Target.Value)
On Error GoTo 0
If Target.Value <> "" Then
If p Is Nothing Then
MsgBox "その名前の画像はありません"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
For Each c In r
s = c.NoteText
If s <> "" Then
v = Split(s, ",")
With Pictures(v(0))
.Top = v(1)
.Left = v(2)
End With
End If
If c.Address <> Target.Address Then
c.ClearComments
c.ClearContents
End If
Next
Application.EnableEvents = True
If Target.Value = "" Then
Target.ClearComments
Exit Sub
End If
Target.NoteText p.Name & "," & p.Top & "," & p.Left
p.Top = Target.Top
p.Left = Target.Width
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Dim p As Picture
Dim myList
Set r = Range(myAdr)
If Intersect(Target, r) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
For Each p In Pictures
myList = myList & "," & p.Name
Next
With r.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=myList
.ShowError = False
.IgnoreBlank = True
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
