[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『画像の上に挿入した画像名を表示したい』(がんばる事務員)
お世話になっております。
下記のマクロをネット上から頂いて、
それを自分仕様に加工する作業をしてます。
そのなかで画像を貼り付けた後、
画像の左上に画像名を貼り付けたいのですが、
付け加えたマクロにエラーがでて困っております。
付け加えた場所は最後のNextの上の方です。↓
「stImageShape.Offset(-1).Value = varFileName」を追加しました。
stImageShape.Offset(-1).で、画像の上のセルを取得したつもりなのですが、ここが間違っているのでしょうか。
お力をお貸し頂ければ嬉しいです。
'//[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]?]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
'//[[ Function : 現在のシートへ選択セル位置から画像を貼り付け ]]
'//[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[]]]?]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
Sub addPhotoTilingSheet()
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ 変数定義 ]] '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] Dim i As Integer ' ファイル操作 Dim varFileName As Variant ' 貼り付ける画像のサイズ Dim iImageWidth As Integer Dim iImageHeight As Integer Dim dLPP As Double ' 画像オブジェクト Dim stImageShape As Shape ' 画像データの横に並べる数 Dim iImageColumnCount As Integer ' 画像データ配置時の隙間指定 Dim iMarginEdge As Integer Dim iMarginCellColumn As Integer Dim iMarginCellRow As Integer ' 初期選択セルの列数記憶 Dim iStartRow As Integer Dim iStartColumn As Integer
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ パラメータ指定 ]] '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]]' '//[[ 画像データの横に並べる数の指定 ]] iImageColumnCount = 2 '//[[ 画像データ配置の隙間 ]] iMarginCellColumn = 1 iMarginCellRow = 2
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ フォルダ選択 ]] '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] varFileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp;*.png;*.jpg", _ Title:="画像ファイルの選択", MultiSelect:=True)
' [[ ファイルパス取得できなかったら ]] If IsArray(varFileName) = False Then Exit Sub End If
i = 1 '//[[ 初期位置Column取得 ]] iStartRow = ActiveCell.Row iStartColumn = ActiveCell.Column '//[[ セル幅単位 ]] dLPP = ActiveCell.ColumnWidth / ActiveCell.Width ' [[ ファイルパス取得できたら ]] For Each Filename In varFileName ' [[ ファイルパスからファイル名を取得 ]]
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ 画像の挿入 '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] Set stImageShape = ActiveSheet.Shapes.AddPicture( _ Filename:=Filename, _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0)
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ 画像のサイズ復元(縦横比固定) '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] With stImageShape .LockAspectRatio = msoTrue .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue
.Width = 210
End With
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ 画像サイズ分のセルサイズ変更 '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] If ActiveCell.Height < stImageShape.Height Then ActiveCell.RowHeight = stImageShape.Height End If If ActiveCell.Width < stImageShape.Width Then ActiveCell.ColumnWidth = stImageShape.Width * dLPP End If '//[[ セル移動 ]] If i Mod iImageColumnCount = 0 Then Cells(ActiveCell.Row + 1 + iMarginCellRow, iStartColumn).Select Else ActiveCell.Offset(0, 1 + iMarginCellColumn).Activate End If
' 10回に1度DoEvents(定期的にWindowsへ(ユーザーへ)制御を戻すため) i = i + 1 If i Mod 10 = 0 Then DoEvents End If
stImageShape.Offset(-1).Value = varFileName
Next
'//[[ 終了時にスタート位置へ戻る ]] Cells(iStartRow, iStartColumn).Select
'//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] '//[[ 終了処理]] '//[[[[[[[[[[[[[[[[]]]]]]]]]]]]]]]] Set varFileName = Nothing Set stImageShape = Nothing
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
セル移動の前に
ActiveCell.Offset(-1, 0).Value = Filename
当然ですが1行目からではエラーになります。この辺ご理解の上での質問ですよね?? ネット上から頂くのは結構ですが、コードの内容は理解されていますか??
(NOx) 2019/01/16(水) 11:07
セル移動の前に
コードを入れたらできました。
でもなぜセルの移動前にコードいれなければ動かないのか、正直わからないです。
まだまだ勉強不足です。
他にも直さなければならないところがいろいろあるので、もう少し細かく調べてみます。
ありがとうございました。
(がんばる事務員) 2019/01/16(水) 11:46
>stImageShape.Offset(-1).で、画像の上のセルを取得したつもりなのですが、ここが間違っているのでしょうか。 ヘルプでShapeオブジェクトメンバを確認してみてくれ。 Shapeオブジェクトには.Offsetなんてメンバはない。 なのでその疑問通り「セルを取得したつもり」というのが間違い。
(ねむねむ) 2019/01/16(水) 11:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.