ここから本文です

エクセルでマクロを作成しているんですが、 あと一つのところでうまくいかずに悩...

mas********さん

2015/6/1201:53:01

エクセルでマクロを作成しているんですが、
あと一つのところでうまくいかずに悩んでいます。

何がしたいかですが、
仮に、A列からAZ列の350行目までを指定し、
指定した範囲の列間に1列ずつ追加します。

指定した範囲にランダムで記載されている
画像URLの画像を追加された空白セルに表示させる。ということをしたいのですが、

現状の構文だと、セルの列間に一列ずつ追加することはできます。
画像URLから空白セルに画像表示に関しては
A列(URL)をB列(空白セル)に展開はできました。
が、それ以外のURL画像表示ができません。
指定範囲の画像がすべて表示されるには、どうすればいいですか?
現状の構文は下記のような感じになります。

~~~~~~~~~~~~~
Private Sub サムネイル生成_Click()

Dim i, j, rng
Dim myDataCnt As Long
Dim myRow1 As Long
Dim myRow2 As Long
Dim myColumn1
Dim myColumn2
Dim myName As String

Cells.Select
Selection.RowHeight = 60
Columns("A:R").Select
Selection.ColumnWidth = 10

'空白列を一列置きに挿入する

j = 1
Set rng = ActiveSheet.UsedRange
For i = rng.Columns.Count To 2 Step -1
rng.Cells(1, i).Resize(, j).EntireColumn.Insert
Next
Set rng = Nothing

myDataCnt = Worksheets("sheet1").Range("A1:R1").End(xlDown).Row

myRow1 = 2
myColumn1 = 1
myRow2 = 69
myColumn2 = 18
Range(Cells(myRow1, myColumn1), Cells(myRow2, myColumn2)).Select

Worksheets("Sheet1").Select
Do Until myRow1 > myDataCnt
myName = Worksheets("Sheet1").Cells(myRow1, 1).Value

'セル選択
Range("A1:R69").Select 'A1からR69までを範囲指定する
If InStr(1, myName, "http") Then
On Error Resume Next 'エラートラップ開始
ActiveSheet.Pictures.Insert(myName).Select
On Error GoTo 0 'エラートラップ終了
If TypeName(Selection) = "Picture" Then '(1)でセルを選択した後にPictures.Insert(myName).Selectしているので、エラーがなければTypeName(Selection)は"Picture" になっている

'画像縦横比について
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 50
If Selection.ShapeRange.Width > 60 Then
Selection.ShapeRange.Width = 60
End If
Selection.ShapeRange.Left = Cells(myRow1, 2).Left
Selection.ShapeRange.Top = Cells(myRow1, 2).Top

End If
End If

myRow1 = myRow1 + 1
myColumn1 = myColumn1 + 1

Loop

End Su

閲覧数:
115
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

mha********さん

2015/6/1215:34:31

まず、次の一文が問題ですね。

myName = Worksheets("Sheet1").Cells(myRow1, 1).Value

これでは、列番号は常に1なので、A列しか参照されません。同様に、

Selection.ShapeRange.Left = Cells(myRow1, 2).Left
Selection.ShapeRange.Top = Cells(myRow1, 2).Top

も、B列しか参照されませんね。
列番号はmyColumn1で指定してあるので、

myName = Worksheets("Sheet1").Cells(myRow1, myColumn1).Value
Selection.ShapeRange.Left = Cells(myRow1, myColumn1 + 1).Left

のようにしないといけません。

それで、DO~LOOP でデータの最初の行から最後の行までを処理してありますが、行のループしかないので、列が正しく遷移しません。なので、行のループの外側に列のループを作ってやる必要があります。

該当部分を修正すると下記のような感じになります。
myRow = 1 や myColumn1 = myColumn1 + 2 と DO~LOOP の位置関係に注意して見てみて下さい。


myColumn1 = 1

'データの右端の列番号
myDataColEnd = ActiveSheet.UsedRange.Columns.Count

Do Until myColumn1 > myDataColEnd
myRow1 = 2

Do Until myRow1 > myDataCnt
myName = Worksheets("Sheet1").Cells(myRow1, myColumn1).Value

'中略

Selection.ShapeRange.Left = Cells(myRow1, myColumn1 + 1).Left
Selection.ShapeRange.Top = Cells(myRow1, myColumn1 + 1).Top

myRow1 = myRow1 + 1
Loop

myColumn1 = myColumn1 + 2 '1列おきだから +1 ではなくて +2です
Loop

この回答は投票によってベストアンサーに選ばれました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる