[[20190116094024]] 『画像の上に挿入した画像名を表示したい』(がんばる事務員) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『画像の上に挿入した画像名を表示したい』(がんばる事務員)

お世話になっております。

下記のマクロをネット上から頂いて、
それを自分仕様に加工する作業をしてます。

そのなかで画像を貼り付けた後、
画像の左上に画像名を貼り付けたいのですが、
付け加えたマクロにエラーがでて困っております。

付け加えた場所は最後の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.