' namaeは変数。
Range("A4").Select
ActiveSheet.Pictures.Insert("M:\" & namae & ".jpg").Select
Sub 画像を貼り付ける() ' -------−−−−−−−−−−−−−−−−−−−−−−
' Excel 2007
Dim StrFilter As String
Dim 画像ファイル As Variant
Dim Tate As Single
Dim Yoko As Single
Dim Top As Single
Dim Left As Single
Dim PicData As Object
' Tate = ActiveCell.Height
Tate = ActiveCell.MergeArea.Height
' Yoko = ActiveCell.Width
Yoko = ActiveCell.MergeArea.Width
画像ファイル = ""
StrFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
画像ファイル = Application.GetOpenFilename(FileFilter:=StrFilter,
_
FilterIndex:=1, _
Title:="画像ファイルを選択してください。",
_
MultiSelect:=False)
If 画像ファイル = "False" Then
Exit Sub
Top = ActiveCell.Top
Left = ActiveCell.Left
' ActiveSheet.Pictures.Insert(画像ファイル).Select
' Selection.ShapeRange.ScaleWidth 倍率, msoFalse,
msoScaleFromTopLeft
' Selection.ShapeRange.ScaleHeight 倍率,
msoFalse, msoScaleFromTopLeft
' ActiveSheet.Shapes.AddPicture 画像ファイル,
True, True, Left, Top, Yoko, Tate
Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル,
True, True, Left, Top, Yoko, Tate)
' AddPicture(Filename, LinkToFile, SaveWithDocument,
Left, Top, Width, Height)
' Filename 必須 文字列型 (String) OLE オブジェクトを作成するグラフィック
ファイルを指定します。
' LinkToFile 必須 MsoTriState 図をグラフィック
ファイルとリンクするかどうかを指定します。
' SaveWithDocument 必須 MsoTriState 文書を保存するときに図も一緒に保存するかどうかを指定します。
' Left 必須 単精度浮動小数点型 (Single) 文書の左上隅を基準にして図の左上隅の位置をポイント単位で指定します。
' Top 必須 単精度浮動小数点型 (Single) 文書の上端を基準にして図の左上隅の位置をポイント単位で指定します。
' Width 必須 単精度浮動小数点型 (Single)
図の幅をポイント単位で指定します。
' Height 必須 単精度浮動小数点型 (Single)
図の高さをポイント単位で指定します。
' 画像にハイパーリンクを設定
ActiveSheet.Hyperlinks.Add Anchor:=PicData,
Address:=画像ファイル
' リンク先をセルに代入しハイパーリンクを設定する
ActiveCell.Offset(1).Value = 画像ファイル
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(1),
Address:=画像ファイル
ActiveCell.Offset(1).ShrinkToFit = True
Set PicData = Nothing
ActiveCell.Offset(, 1).Select
End Sub
Sub 画像を貼り付ける2() '−−−−−−−−−−−−−−−−−−−−−−−
' Excel 2007
Dim StrFilter As String
Dim 画像ファイル As Variant
Dim Tate As Single
Dim Yoko As Single
Dim Top As Single
Dim Left As Single
Dim PicData As Object
' Tate = ActiveCell.Height
Tate = ActiveCell.MergeArea.Height
' Yoko = ActiveCell.Width
Yoko = ActiveCell.MergeArea.Width
画像ファイル = ""
StrFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
画像ファイル = Application.GetOpenFilename(FileFilter:=StrFilter,
_
FilterIndex:=1, _
Title:="画像ファイルを選択してください。",
_
MultiSelect:=False)
If 画像ファイル = "False" Then
Exit Sub
Top = ActiveCell.Top
Left = ActiveCell.Left
Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル,
True, True, Left, Top, Yoko, Tate)
Set PicData = Nothing
ActiveCell.Offset(, 1).Select
End Sub
Sub 画像の大きさをセルに合わせる() '−−−−−−−−−−−−−−−
Dim pic As Shape
For Each pic In ActiveSheet.Shapes
If pic.Type = msoLinkedPicture Then
' If pic.Type = msoPicture Then
With pic.TopLeftCell
pic.LockAspectRatio = msoFalse
pic.Top = .Top
pic.Left = .Left
pic.Width = .MergeArea.Width
pic.Height = .MergeArea.Height
End With
End If
Next
End Sub
Sub 選択ファイルのリンク先名をパイパーリンク() ' −−−−−−−−−−−−−−−−
Dim StrFilter As String
Dim 画像ファイル As Variant
画像ファイル = ""
StrFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
画像ファイル = Application.GetOpenFilename(FileFilter:=StrFilter,
_
FilterIndex:=1, _
Title:="画像ファイルを選択してください。",
_
MultiSelect:=False)
If 画像ファイル = "False" Then
Exit Sub
' リンク先をセルに代入しハイパーリンクを設定する
' ActiveCell.Value = 画像ファイル
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell,
Address:=画像ファイル
ActiveCell.ShrinkToFit = True
ActiveCell.Offset(, 1).Select
End Sub