excelで商品の表(100行くらい)をつくりたいのですが、それぞれの商品に写真をつけたいと思います。
各行の項目として番号、商品名、説明、備考に加えて、右端に写真用のボタンがあって、そこをクリックするとウインドウが開き写真が見られて、写真を閉じるとまた表に戻るようなものがいいと思っています。
商品名を見たり、写真を見たりということを頻繁に繰り返すので、ハイパーリンクで別の場所に飛んでいって戻るのに操作が必要というよりは、写真を閉じるだけで元の表に戻れるという作りにしたいです。
そういう意味では、オブジェクトで写真を挿入し、写真は小さく縮めセルに収まるようなサイズにし、クリックしたらみられるようにしたいと思っています。
各行に挿入したオブジェクトがそれぞれの商品の写真の欄(セル)に固定されるようにするにはどうしたらいいでしょうか。
今はカーソルを動かすとセルを越えて動いてしまいますし、反対に、オブジェクトやシートロックをするとクリックしても写真が見られないという状態です。
それぞれの写真がそれぞれの行に収まって固定され、クリックするとすぐ見られ、すぐに閉じられるというためにはどうすればよいでしょうか。
このような動きができるほかのいい方法があれば、オブジェクトを使わなくてもいいです。
このファイルはメールで送信するのが前提です。
よろしくお願いいたします。
No.2ベストアンサー
- 回答日時:
#1です。
誰も期待していないと思いますが、グラフを介する方法がうまくいかなかった理由が判明しました。一旦ワークシートに貼付、縮小し、切り取り、JPEGで再度貼り付ける事でリサイズしようとしていたのですが、ワークシートに貼り付けているつもりが、グラフ上に貼り付けてしまっていたのでした。コードは次の通りですが、試行錯誤の名残で冗長かもしれません。xl2010でも動作しましたが、xl2000では発生しなかった広い余白が発生したりします。また、画面更新を止めてあるつもりですが、一瞬画像の切り貼りが表示されたりします。
添付画像は少々わかりにくいかもしれませんが、xl2010での実行例です。
Sub pastePic2Comment()
Dim myComment As Comment
Dim myWidth As Double, myHeight As Double
Dim myChart As Chart, myChartName As String
Dim currentWS As Worksheet, currentCell As Range
Dim myPicture As Picture
Dim picPath As String
Const lsLength As Double = 300
Set currentCell = ActiveCell
Application.ScreenUpdating = False
picPath = Application.GetOpenFilename("画像ファイル , *.*")
If picPath = "False" Then Exit Sub
Set currentWS = ActiveSheet
Set myPicture = currentWS.Pictures.Insert(picPath)
With myPicture
If .Width > .Height Then
myWidth = lsLength
myHeight = lsLength * .Height / .Width
Else
myWidth = lsLength * .Width / .Height
myHeight = lsLength
End If
.Width = myWidth
.Height = myHeight
End With
Set myChart = Charts.Add
Set myChart = myChart.Location(Where:=xlLocationAsObject, Name:=currentWS.Name)
myChart.ChartArea.Border.LineStyle = 0
myChartName = Trim(Replace(myChart.Name, currentWS.Name, ""))
currentWS.Shapes(myChartName).Width = myWidth + 6
currentWS.Shapes(myChartName).Height = myHeight + 6
myPicture.Cut
currentCell.Activate
currentWS.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Set myPicture = Selection
myPicture.Cut
myChart.Paste
myChart.Export "C:\temp.jpg"
currentWS.Shapes(myChartName).Delete
ActiveCell.ClearComments
Set myComment = ActiveCell.AddComment
With myComment.Shape
.Line.Visible = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.UserPicture "C:\temp.jpg"
.Width = myWidth
.Height = myHeight
End With
Application.ScreenUpdating = True
End Sub
重ねてのお返事本当にありがとうございました。
御礼が遅くなり、大変申しわけありません。
せっかく詳しくお教え下さったのですが、残念ながら私にはちょっと理解が及ばないです。
ご丁寧な回答をいただいたのに、本当に申しわけありません。
どなたかが、検索等でこの質問を見て役に立てて下さることを祈っています。
何度もご丁寧にありがとうございました。
No.1
- 回答日時:
お望みの物とは異なると思いますが、昔投稿した、コメントに縮小画像を貼り付けるコードの簡略化にトライしてみました。
コメントに貼り付けるにはリサイズした画像をファイル保存後、読みこむ必要があります。縮小画像の保存にChartのExport機能を使おうと試みましたが、Chartに貼り付ける際に画像が変形されてしまってうまくいっておりません。
やむを得ずOfficeのグラフィックフィルターを用いる方法を使用しておりますが、JPEGの画質はいまいちです。
xl2010(WinXP SP3)での動作も確認しましたが、xl2000より画像の変換が非常に遅いです(前者はCeleron2.4G、後者はPentiumM 1.3G)2000ではプログレスバーが殆ど視認できないのに対し、2010では一秒近く表示されています。
Private Type FLTIMAGE
StructSize As Integer
Type As Byte
Reserved1(0 To 8) As Byte
hImage As Long
Reserved3(0 To 19) As Byte
End Type
Private Type FLTFILE
Reserved1 As Integer
Ext As String * 4
Reserved2 As Integer
Path As String * 260
Reserved3 As Currency
End Type
Private Declare Function GetFilterInfo Lib _
"C:\Program Files\Common Files\Microsoft Shared\Grphflt\JPEGIM32.FLT" _
(ByVal Ver As Integer, ByVal Reserved As Long, _
phMem As Long, ByVal flags As Long) As Long
Private Declare Function ExportGr Lib "JPEGIM32.FLT" _
(ff As FLTFILE, fi As FLTIMAGE, ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" _
(ByVal hWndNewOwner As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" _
(ByVal uFormat As Long) As Long
Const CF_ENHMETAFILE = 14
Private Declare Function CopyEnhMetaFile Lib "gdi32" _
Alias "CopyEnhMetaFileA" _
(ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function DeleteEnhMetaFile Lib "gdi32" _
(ByVal hemf As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Sub pastePic2Comment()
Dim myComment As Comment
Dim myWidth As Double, myHeight As Double
Dim myChart As Chart, myChartName As String
Dim currentWS As Worksheet
Dim myPicture As Picture
Dim picPath As String
Const lsLength As Double = 400 'ここで画像の長片サイズを指定
Application.ScreenUpdating = False
picPath = Application.GetOpenFilename("画像ファイル , *.*")
If picPath = "False" Then Exit Sub
Set currentWS = ActiveSheet
Set myPicture = currentWS.Pictures.Insert(picPath)
With myPicture
If .Width > .Height Then
myWidth = lsLength
myHeight = lsLength * .Height / .Width
Else
myWidth = lsLength * .Width / .Height
myHeight = lsLength
End If
.Width = myWidth
.Height = myHeight
End With
SaveClipToJpg myPicture, "c:\temp.jpg"
myPicture.Delete
ActiveCell.ClearComments
Set myComment = ActiveCell.AddComment
With myComment.Shape
.Line.Visible = msoTrue
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.UserPicture "C:\temp.jpg"
.Width = myWidth
.Height = myHeight
End With
Application.ScreenUpdating = True
End Sub
' 出典 : http://vbatips.blog37.fc2.com/blog-entry-26.html …
'imgの型のみ変更
Function SaveClipToJpg(img As Picture, Path As String) As Boolean
Dim tFltImg As FLTIMAGE
Dim tFltFile As FLTFILE
Dim hemf As Long
Dim hMem As Long
SaveClipToJpg = False
'クリップボードにコピー
img.CopyPicture
'Selection.CopyPicture
If OpenClipboard(0) Then
hemf = CopyEnhMetaFile( _
GetClipboardData(CF_ENHMETAFILE), _
vbNullString)
CloseClipboard
End If
If hemf = 0 Then Exit Function
' パラメータ設定
tFltFile.Path = Path & vbNullChar
With tFltImg
.StructSize = LenB(tFltImg)
.Type = 1
.hImage = hemf
End With
' フィルタ呼び出し
If GetFilterInfo(3, 0, hMem, &H10000) And &H10 Then
If ExportGr(tFltFile, tFltImg, hMem) = 0 Then
SaveClipToJpg = True
End If
End If
If hMem Then GlobalFree hMem
DeleteEnhMetaFile hemf
End Function
画像を100個もブックに取り込むとファイルが大きくなり、メール送信できなくなりますので、画像サイズを調整して下さい。
長片サイズ400で、330KB/10画像、100の場合で50KB/10画像程度でした。ご参考まで。
参考URL:http://vbatips.blog37.fc2.com/blog-entry-26.html …
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelで写真左の表みたいなものがあった時、写真右の表みたいに同じ名前の商品の個数をそれぞれ出す方 8 2022/08/09 06:13
- メルカリ メルカリの事で相談させてください。 購入者から、イメージと違ったとのことで一方的にキャンセル申請され 6 2022/12/25 13:51
- その他(ビジネススキル・経営ノウハウ) クラウドファウンディングによる新製品の販売支援要求。「あれ?この商品、もう完成品じゃね?」という疑問 2 2022/08/22 12:32
- メルカリ メルカリにて 商品の写真には商品説明欄と違う物の掲載があるのに 発送されてきたのは、説明欄にある内容 5 2022/06/02 04:58
- その他(クラウドサービス・オンラインストレージ) ヤマップは自分のアルバムになるか 1 2022/11/08 17:20
- Excel(エクセル) excelで検索した商品の画像(ネットワーク上の)を表示させたい。 3 2023/06/28 00:32
- 飲食店・レストラン 松屋アンド松のやのメニューについて。 松屋と松のやが合体した店舗があり、写真のメニューを注文しました 1 2022/05/01 20:31
- Photoshop(フォトショップ) 写真に日付を入れるのがそんなに大変か 9 2023/07/22 14:38
- ドライブ・ストレージ windowsで写真を上下反転 4 2022/07/03 10:49
- Excel(エクセル) Excel VBAについてです。 少しだけ知識はあるのですが、 うまくいかなかったので 質問させてい 3 2022/09/13 18:40
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
同級生の顔を使ってエロ画像を...
-
JPEGファイルに文字を入れたい
-
iPhoneで写真を撮りました。 端...
-
至急回答お願いします、彼氏に...
-
整形外科などで、MRIやレントゲ...
-
tiffファイルの解像度変更の仕方
-
ワードで 「ぼかし」の機能はど...
-
マクロで画像挿入→エラー「リン...
-
「強調」の対義語は何ですか?
-
結婚して2ヶ月の旦那のスマホの...
-
エクセル 写真 貼り付け
-
エクセル・ワードの表を画像化...
-
可愛い子はプリクラが盛れない...
-
pixivの画像を保存しようとした...
-
コンクリートが茶色になってし...
-
2Lサイズの写真のトリミングの...
-
カメラのRAW画像とビットマップ...
-
彼氏の携帯から、パンチラ画像...
-
Word差し込み印刷 画像更新され...
-
EXIF情報がない場合はどのよう...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
同級生の顔を使ってエロ画像を...
-
iPhoneで写真を撮りました。 端...
-
可愛い子はプリクラが盛れない...
-
マクロで画像挿入→エラー「リン...
-
JPEGファイルに文字を入れたい
-
至急回答お願いします、彼氏に...
-
pixivの画像を保存しようとした...
-
写真の下に文字を入れるには?
-
tiffファイルの解像度変更の仕方
-
整形外科などで、MRIやレントゲ...
-
PCでPDFファイルを電子書籍のよ...
-
受信した添付写真を大きくする
-
「湾岸の千葉君」での秀里毅の写真
-
撮影日時をそのままに残して画...
-
エクセル・ワードの表を画像化...
-
「強調」の対義語は何ですか?
-
グーグル画像検索にかからない...
-
持っている写真の画質を上げる...
-
EXIF情報がない場合はどのよう...
-
Word差し込み印刷 画像更新され...
おすすめ情報