[[20181219175732]]　『画像挿入したものが、ネットワークにあるで別のPC』（さる）　ページの最後に飛ぶ

『画像挿入したものが、ネットワークにあるで別のPCで見るとみれない』（さる）

マクロで画像を挿入したのですが、
ネットワークにあるで別のPCで見るとみれませんいかの表示になります。
「このイメージは、現在表示できません。」

挿入元の画像のフォルダーはA1に入力しています
B5に挿入したいファイル名があります。
8行ごとにファイル名が入力されています
B5
B13
B21
B29
・
・
・
・
と

そして、挿入する画像は
挿入したいファイル名の1行下に挿入いたします。
B6
B14
B22
B30
・
・
・
・
と

マクロ自体は動いたのですが、
別のPCで見たときに
「このイメージは、現在表示できません。」
表示され、見ることができません。
もしわかるようでしたらお願いします

これが作ったマクロです。

Sub B列実行()

 Dim i As Long
 Dim A, B, C, D As Variant
    BCol_MaxRow = Range("B1000").End(xlUp).Row
    D = BCol_MaxRow - 9
    Range("A1").Select
    A = Range("A1").Value '画像保存フォルダ
'    For i = -2 To Cells(Rows.Count, 2).End(xlUp).Row
    For i = -2 To D
        i = i + 7
        If Cells(i, 2) <> "" Then Cells(i, 2) = Cells(i, 2)
            C = Cells(i, 2).Value '商品番号
            B = i + 1 '画像挿入セル
            Cells(B, 2).Select
            ActiveSheet.Pictures.Insert(A & C & ".jpg").Select
            Application.CutCopyMode = False
            Selection.ShapeRange.ScaleHeight 0.44, msoFalse, msoScaleFromTopLeft
            Selection.ShapeRange.Height = 130.3937007874
            Selection.ShapeRange.IncrementLeft 1.25 '画像移動
            Selection.ShapeRange.IncrementLeft 1.25 '画像移動
    Next i
 End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

＞挿入元の画像のフォルダー

これもネットワーク上にあるのでしょうか。

（マナ） 2018/12/19(水) 18:31

リンク貼り付けをやめてはどうでしょうか。
https://www.moug.net/tech/exvba/0120020.html

（マナ） 2018/12/19(水) 18:35

マナさんありがとうございます。

＞これもネットワーク上にあるのでしょうか。
ネットワーク上にあります。

ご意見ありがとうございます。
以下のように作り変えましたが、
(1)までは画像を貼り付けることができ大きさも思った大きさに調整できましたが、

(2)になると画像が大きくなってしまいます。
よろしければ(1)で調整した大きさで(2)を
実行することは可能でしょうか？
　　----------------ここを変えてみました-------------

                With myShape
                    .ScaleHeight 0.44, msoTrue
                    .ScaleWidth 0.44, msoTrue
                End With
　　------------------------------------------------
＊元の画像は大きさがまちまちなので、
　倍率では思った大きさに変更することができません。

Sub B列実行()

 Dim i As Long
 Dim A, B, C, D, E, F, G As Variant
 Dim myFileName As String '-
 Dim myShape As Shape '-
    BCol_MaxRow = Range("B1000").End(xlUp).Row
    D = BCol_MaxRow - 9
    BCol_MaxRow = Range("F1000").End(xlUp).Row
    E = BCol_MaxRow - 9
    BCol_MaxRow = Range("J1000").End(xlUp).Row
    F = BCol_MaxRow - 9
    BCol_MaxRow = Range("N1000").End(xlUp).Row
    G = BCol_MaxRow - 9
    Range("A1").Select
    A = Range("A1").Value '画像保存フォルダ
    For i = -2 To D
        i = i + 7
        If Cells(i, 2) <> "" Then Cells(i, 2) = Cells(i, 2)
            C = Cells(i, 2).Value '商品番号
            B = i + 1 '画像挿入セル
            Cells(B, 2).Select
            myFileName = A & C & ".jpg"
            '--(1) 選択位置に画像ファイルを挿入し、変数myShapeに格納
                Set myShape = ActiveSheet.Shapes.AddPicture( _
                    Filename:=myFileName, _
                    LinkToFile:=False, _
                    SaveWithDocument:=True, _
                    Left:=Selection.Left, _
                    Top:=Selection.Top, _
                    Width:=130, _
                    Height:=130)
            '--(2) 挿入した画像に対して元画像と同じ高さ・幅にする
                With myShape
                    .ScaleHeight 1, msoTrue
                    .ScaleWidth 1, msoTrue
                End With
    Next i
        ActiveSheet.Shapes.SelectAll '画像全選択
        Selection.ShapeRange.IncrementLeft 1.0714173228 '画像移動
        Selection.ShapeRange.IncrementLeft 1.0714173228 '画像移動
 End Sub

（さる） 2018/12/20(木) 13:30

マナさんありがとうございます。
以下に変更しましたらいけました。

ありがとうございます

    Next i
        ActiveSheet.Shapes.SelectAll '画像全選択
        Selection.ShapeRange.LockAspectRatio = msoTrue
        Selection.ShapeRange.Height = 130
        Selection.ShapeRange.IncrementLeft 2 '画像移動
 End Sub

（さる） 2018/12/20(木) 15:40

コメント返信：

[ 一覧(最新更新順) ]

[[20181219175732]] 『画像挿入したものが、ネットワークにあるで別のPC』（さる） ページの最後に飛ぶ

[[20181219175732]]　『画像挿入したものが、ネットワークにあるで別のPC』（さる）　ページの最後に飛ぶ