| |
フォーム上のイメージコントロールに画像を表示し、
その画像で良ければ、OKボタンを押してセルに張付けたい。
下記のコードで、画像ファイルのフルパスをセルに書き出さずに
フルパスを受け取りたいのですが、どのように直せば良いか教えて下さい。
以下、コード。
画像をファイルから選択し、Image1に表示。----------------------------------------------------
Sub CommandButton1_Click
Dim FileType As String
Dim Dialog As String
Dim Filename As Variant
FileType = "画像ﾌｧｲﾙ (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png," _
& "JPEG 形式 (*.jpg),*.jpg," _
& "GIF 形式 (*.gif),*.gif," _
& "PNG 形式 (*.png),*.png"
Dialog = "画像ファイルの選択"
Filename = Application.GetOpenFilename(FileType, , Dialog)
If Filename <> False Then
Image1.Picture = LoadPicture(Filename)
Else
Image1.Picture = LoadPicture("")
End If
End Sub
Image1の画像で良ければ、セルに貼付け。------------------------------------------------------
CommandButton2_Click
Dim Filename As Variant
Dim Shape As Variant
Dim MovCell As Range
Dim MovLeft As Double
Dim MovTop As Double
Dim MovHeight As Double
Dim MovWidth As Double
If Filename <> False Then
For Each Shape In Worksheets("Sheet1").DrawingObjects
If Not Intersect(Shape.TopLeftCell, Worksheets("Sheet1"). _
Range("F10:I21")) Is Nothing Then
Shape.Delete
End If
Next
Worksheets("Sheet1").Range("F10:I21").Value = Dir(Filename)
With Worksheets("Sheet1").Range("F10:I21")
MovLeft = .Left
MovTop = .Top
MovHeight = .Cells(.Count).Offset(1).Top - .Top
MovWidth = .Cells(.Count).Offset(, 1).Left - .Left
End With
With Worksheets("Sheet1").Shapes.AddPicture(Filename:=Filename, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Selection.Left, _
Top:=Selection.Top, Width:=0, Height:=0)
End With
With Worksheets("Sheet1").Pictures(Worksheets("Sheet1").Pictures.Count).ShapeRange
.LockAspectRatio = msoFalse
.Parent.Visible = msoTrue
.Left = MovLeft
.Top = MovTop
.Height = MovHeight
.Width = MovWidth
.Line.Visible = msoTrue
.Line.Style = msoLineSingle
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.Weight = 1.5
.Name = Dir(Filename)
End With
Else
For Each Shape In Worksheets("Sheet1").DrawingObjects
If Not Intersect(Shape.TopLeftCell, Worksheets("Sheet1"). _
Range("F10:I21")) Is Nothing Then
End
End If
Next
Worksheets("Sheet1").Range("F10:I21").Value = "ファイルが選択されていません。"
End If
|
|
マナ
- 18/8/31(金) 20:34 -
ノンボ
- 18/8/31(金) 20:23 -
ノンボ
