Excelを用いコンタクトシートのような配列で
画像を挿入(複数)させるマクロを作成したいのですが
「縦5枚×横3枚」のような配列にする時に
「横3枚」挿入させる方法がわかりません。
ご教授お願い申し上げます。


Q:下記のような配列で画像を挿入するには?
-------------------------------------------
   A   B   C   D   E   F
1     01.jpg    02.jpg    03.jpg
2
3     04.jpg    05.jpg    06.jpg
4
5     07.jpg    08.jpg    09.jpg
6
7     10.jpg    11.jpg    12.jpg
8
9     13.jpg    14.jpg    15.jpg
10
       ---次ページ---
11    16.jpg    17.jpg    18.jpg
12
13    19.jpg    20.jpg    21.jpg
14
15    22.jpg    23.jpg    24.jpg
16
17    25.jpg    26.jpg    27.jpg
18
19    28.jpg    29.jpg    30.jpg
20
       ---次ページ---
21    31.jpg    32.jpg    33.jpg
22
23    34.jpg    35.jpg    36.jpg
24
25    37.jpg    38.jpg    39.jpg




-------------------------------------------


※画像挿入のマクロに関してはこちら↓の質問を参考にしています。
 質問番号:4676078
 「エクセルで写真挿入 マクロ」
 http://oshiete1.goo.ne.jp/qa4676078.html
※画像はJPG形式に限りません。(BMP、GIF等も)
※コンタクトシート作成ソフトは使いませんので
 必ずExcelでマクロを使用する方法をご回答願います。

このQ&Aに関連する最新のQ&A

A 回答 (2件)

ご提示のコードだと、スタートセル(C4)から順に次のセルを決めて行く方式ですので、わざわざ行・列を計算しなくても、次のセルの位置を指定すればよくなっていますね。



現在のセルに対して次のセルは、基本的には右へ2列なので
 ActiveCell.Offset(0,2).Select
となりますし、もし現在のセルがE列より右なら(折り返すので)
 ActiveCell.Offset(2,-4).Select
みたいになります。

両方を合わせれば
 If ActiveCell.column>5 then ActiveCell.offset(0,2).select else AitiveCell.Offset(2,-4).select
で次のセルが決まるのでは?

この回答への補足

ご回答ありがとうございます。
詳しいご回答を頂いたのですが、コードをうまく実行できず
「横3枚」まで行かず、「横2枚」で折り返してしまいます。
何度も申し訳ございませんが、現在は以下のコードとなっていますので
再度ご教授お願い申し上げます。


Sub 複数の画像を挿入()

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)

' 貼り付け開始セルを選択
'ActicveCellRange("B4").Select


' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の高さをアクティブセルにあわせる
' 結合セルの場合でも対応
.Height = ActiveCell.MergeArea.Height
End With

' 次の貼り付け先を選択(アクティブセルにする)[例:6個下のセル]
Select Case i Mod 2
Case 1 '奇数回目
ActiveCell.Offset(0, 2).Select
Case 0 '偶数回目
ActiveCell.Offset(9, -2).Select
End Select

Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation

End Sub

' バブルソート(文字列)
Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)

If Not IsArray(Source) Then Exit Sub

Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i

End Sub

補足日時:2009/05/27 11:23
    • good
    • 0
この回答へのお礼

補足

【使用環境】
Microsoft Windows XP Professional
Microsoft Office Excel 2003 SP3
Microsoft Visual Basic 6.5

お礼日時:2009/05/27 12:01

例えば全体をループで回していると仮定して、i番目の画像をどこに配置するかを対応できれば良いですよね?



質問文に合わせるなら、列はB、D、Fの順(偶数列)、行は1、3、5(奇数行)…が対象となっているとして

i のループが1から始まると仮定すれば、i番に対応する行番号、列番号は
 行番号 = Int((i - 1) / 3) * 2 + 1
 列番号 = ((i - 1) Mod 3 + 1) * 2
で求められますので、そこに貼り付けるようにすればよいのでは?
(iのスタートを0からにする方が、対応式は簡単になります)

逆に、行番号、列番号から対応するインデックス番号(=i)を求めるには
 i = ((rw-1)*3+col)/2 (rw:行番号、col:列番号)
となります。

対象となる行や列が違う場合でも、対応関係が規則的なら読み替えの式が作成できるはずですので、このような式を元に対応させてゆくのが簡単化と思います。

この回答への補足

ご回答頂きありがとうございました。
大変お恥ずかしい話ですが、ご教授頂いたコードを
どの位置に貼り付ければ良いのか検討がつきません。
お手数をお掛けして申し訳ございませんが
下記のコードに当てはめご回答頂ければ頂けれ幸いです。
宜しくお願い申し上げます。


Sub 複数の画像を挿入()

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)

' 貼り付け開始セルを選択
'ActicveCellRange("C4").Select


' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の高さをアクティブセルにあわせる
' 結合セルの場合でも対応
.Height = ActiveCell.MergeArea.Height
End With

' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
ActiveCell.Offset(5).Select

Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation

End Sub

' バブルソート(文字列)
Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)

If Not IsArray(Source) Then Exit Sub

Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i

End Sub

補足日時:2009/05/26 18:36
    • good
    • 0
この回答へのお礼

ご回答頂きありがとうございました。
その後いろいろ試行しながら貼り付け先を調整して
無事に解決しました。
ありがとうございました。
(入力欄が前後してしまい申し訳ございません。)


' 次の貼り付け先を選択(アクティブセルにする)
Select Case i Mod 3
Case 2
ActiveCell.Offset(0, 2).Select
Case 1
ActiveCell.Offset(0, 2).Select
Case 0
ActiveCell.Offset(9, -5).Select
End Select

お礼日時:2009/05/27 19:38

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q遠近両用コンタクトレンズを使っている方!教えて!

友達が長年コンタクトレンズを使っていますが、最近近くが見えにくくなったとのことで、遠近両用コンタクトレンズを使おうか迷っているそうです。最近の遠近両用コンタクトレンズは、すごく良くなったとのことですが、実際使っておられる方良い点と悪い点を教えてください。

Aベストアンサー

使って3年位になります。
便利かなと思って買ったのですが、結局は近眼用としてのみ使っています。
小さな字をみたりする時は、顔を少し上に向けて目は下を見る、すなわちレンズの周り(端の方)を使ってみなければならないので、私の場合はそれがうまくできないのです。
私が買った時よりも、もっと使いやすいのが出ているかもわかりませんが・・・・
価格的にも、普通のコンタクトよりは割高になると思います。

Q一枚ずつ印刷用のマクロに複数枚設定したい

一枚ずつ印刷用のマクロに複数枚設定したい。マクロ初心者です。Excel2007のマクロシー
トを使っています。作成者は他人ですので、質問ができません。複数のシートからなるExcelファイルで、シート1に入力したシーケンス番号を2のシートのマクロを起動してポップアップに入力すると、シート1の内容が反映された印刷用のフォーマットが1枚ずつ作成されるマクロがあります。シーケンス番号は200ほどあり、ひとつひとつ設定していると時間がかかるため、シーケンス番号の範囲を指定するなどして、印刷を一気に行う方法はありませんでしょうか?質問等に不備がございましたらお知らせください。よろしくお願いいたします。

Aベストアンサー

まずはそのマクロとやらがわからないのでは、的確な回答ができない


手段としては
1)その印刷マクロ自体を書き換える
2)シーケンス番号とやらを範囲指定し、その範囲指定した回数分、既存の印刷マクロをシーケンス番号を指定して実行するループをマクロで作成する
3)まったく新規にマクロを作成する

等が考えられる、2の場合も既存印刷マクロの一部修正が必要の可能性はあるが、大きな変更では無いので一番容易かと思われる

Q遠近両用コンタクトレンズは防腐剤入りの目薬を使ってはいけないの?

遠近両用コンタクトレンズは防腐剤入りの目薬を使ってはいけないの?
先日、遠近両用のコンタクトレンズを使い始めたのですが、
診察の時に「目が乾いた時は防腐剤の入っていない目薬を使って下さい」と言われました。
遠近両用になると防腐剤の入っていないものでないと、いけないのでしょうか?
コンタクトレンズはソフトで終日装用です。

よろしくお願いします。

Aベストアンサー

それは遠近両用だからではなく、ソフトコンタクトレンズだからです。
ソフトはハードに比べ、レンズ内に防腐剤が多く残りやすいといわれているためです。
ただ防腐剤の蓄積量は、正しい洗浄をしていれば問題ないという意見もあります。

Qエクセルのシートに挿入した画像を別シートに挿入している画像と差し替えマクロ

表題の通り、
ある条件の元、エクセルのシートに挿入した画像の入れ替えが発生するのですが、そのようなマクロを組んだこともなく、
どこから手をつけていいのか分かりません。

シート上に貼り付けただけの画像の差し替えなどはできるのでしょうか?ご教授頂けると助かります。
よろしくお願い致します。

Aベストアンサー

http://www.moug.net/faq/viewtopic.php?t=39446
に格好の解説が有るのでは。
ーー
別にイメージ=喩えの話をしてみる。
写真は挿入とは言うが、シートに置かせてもらって、浮いている存在のように思う。その写真の位置は、Top,Lehtの位置を指定できて、別途シートのセルのTop,Leftが捉えられるから、それと関連付けて、繋ぎ止めておく場所はセルに関連付けられるようなイメージです。セルと言う家の門の前に写真を置かせてもらうイメージ。
しかし決して家の中に入りこむ、と喩えられる、セルの属性たる、値やコメントや数式などとは異質の物です。山田さんの家の前においてある写真も、山田さんの家の写真を取り除けと言うわけには行かず、別途何番の写真を取り除けという指示になる。
ーー
2002,2003では
マクロの記録は
Sub Macroi()
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg" _
).Select
End Sub
となる。これが2007で動かないかやってみてください。
ーーー
シートに2つの写真を貼り付けると
Sub test01()
Dim shp As Object
For Each shp In ActiveSheet.Shapes
MsgBox shp.Name
Next
End Sub
を実行すると、Picture 1、Picture 2と返る。これが写真のオブジェクトの名前だ。
これで、Picture 2を削除するのは
Sub test02()
ActiveSheet.Shapes(2).Delete
End Sub
名前で指定するなら
Sub test03()
ActiveSheet.Shapes("Picture 2").Delete
End Sub
ーー
上記から、写真以外のオブジェクトがシートに張り付いてないとして
セル番地(Top,Leftで座標的な位置指定に使う)ーPicture番号(オブk\ジェクトの名前)ー写真ファイル名ー内容(何の写真か)
の対応関係を管理しないと行けなくなると思う。
靴の何番の写真を抹消ー>Picture番号(オブジェクト名)ー>上記コードで抹消となり、入れ替える商品の写真については、新たに上記の4要素を管理する必要が出て来る。挿入すると、Picture番号は変わるので厄介だ。
以上2007でもやってみてください。並みのVBAの経験では難しいと思うな。
ACCESSのテーブルにも商品コードなどと対応して、写真を持てる仕組みがあるので、ACCESSの解説書ででも、そちらも勉強してみてください。

http://www.moug.net/faq/viewtopic.php?t=39446
に格好の解説が有るのでは。
ーー
別にイメージ=喩えの話をしてみる。
写真は挿入とは言うが、シートに置かせてもらって、浮いている存在のように思う。その写真の位置は、Top,Lehtの位置を指定できて、別途シートのセルのTop,Leftが捉えられるから、それと関連付けて、繋ぎ止めておく場所はセルに関連付けられるようなイメージです。セルと言う家の門の前に写真を置かせてもらうイメージ。
しかし決して家の中に入りこむ、と喩えられる、セルの属性たる、値...続きを読む

Q遠近両用コンタクトレンズ

現在遠近両用眼鏡をしてますが、以前近視用コンタクトレンズを使用していたこともあり、どうしても視野が広いのと明るいので、遠近両用コンタクトレンズを検討してますが、どなたか使用されている方実際の使用している上での不都合とか教えて頂きたいのですがよろしくお願いいたします

Aベストアンサー

ふたたび#1です。

どちらかに重点をおく場合の解決策としては、
重点を置くほうのコンタクトレンズを作り、上からメガネをかけて重点を置かないほうを補うのです。

やはり、もう少し改良されるのを待つのが懸命かなと思います。

QEXCELマクロの列挿入で余分に列が挿入されてしまいます。

EXCELで5セルづつ結合された表があり、決まった列数ごとに2列挿入して合計欄を作りたいのですが、手
動で2列選択してツールバーより挿入とすると2列のみ挿入されますが、マクロで2列選択して挿入se
lection.insertをするとなぜか連結セル分5列選択し挿入されてしまうのですが、2列のみ挿入するには
どうしたらいいのでしょうか。
For i = 72 To t Step 72
Sheets("描画表").Select
'Column(列)変換
y2 = IIf(y > 26, Chr(y \ 26 + &H40), "") & Chr(y Mod 26 + &H41)
y3 = IIf((y + 1) > 26, Chr((y + 1) \ 26 + &H40), "") & Chr((y + 1) Mod 26 + &H41)
Columns("" & y2 & ":" & y3 & "").Select
Selection.Insert Shift:=xlToRight

ローカルウィンドウでマクロのステップをチェックするとy2、y3ともちゃんと列番号が入っているように思うのですがよろしくおねがいします

EXCELで5セルづつ結合された表があり、決まった列数ごとに2列挿入して合計欄を作りたいのですが、手
動で2列選択してツールバーより挿入とすると2列のみ挿入されますが、マクロで2列選択して挿入se
lection.insertをするとなぜか連結セル分5列選択し挿入されてしまうのですが、2列のみ挿入するには
どうしたらいいのでしょうか。
For i = 72 To t Step 72
Sheets("描画表").Select
'Column(列)変換
y2 = IIf(y > 26, Chr(y \ 26 + &H40), "") & Chr(y Mod 26 + &H41)
...続きを読む

Aベストアンサー

ちょっと問題が理解しにくいです・・・・

yが、ソース中で定義されていないので、分かりにくいのですが、yを左のセルから動かしていませんか?
それでしたら右のセルから動かしたら、うまくいくでしょう。
For y = 最終目的列 To 開始目的列 Step -72
のように。

あと列を文字列に変換するの必要だと思えません。
x列目で2列挿入するなら
Range(Columns(x), Columns(x + 1)).Insert Shift:=xlToRight
でいいと思います。

Q遠近両用コンタクトレンズとメガネの併用について

現在、ハードタイプの遠近両用コンタクトレンズを装着しています。
56歳。コンタクトレンズ歴40年。遠近両用タイプを使って10年くらいでしょうか。乱視もきつい。

昔はとてもよいと思っていたのですが、近年老眼が顕著になり、遠くも見えにくくなりました。
そんなわけで、今はコンタクトを常用していますが、会議などで遠くの小さな字を観るときには、コンタクトの上から、さらに遠くが見えるためのめがねをかけてます。 また近くの小さい字を見るときには、コンタクトの上から老眼鏡を掛けている次第です。(どちらも必要に応じて、たまに、です。)

最近、コンタクトをしていて、とても目が疲れます。 視力は0.8-1.0位だと思います。
もう少し度を下げて、今まで同様に二つのめがねを併用しようかと思っておりますが、何分にも遠近両用コンタクトレンズは高価です。
ならばこの際、安い単焦点レンズにして、めがねを併用してはとも思います。
この場合は、めがねを使う頻度が多くなるのかな?とか思います。
何かベターな選択肢が他にありましたらお教えください。

Aベストアンサー

こんばんは

遠近両用の度が変わっていると思いますので
眼科で確認してもらってください

Qマクロで行挿入後挿入部分を含めたソートをしたいのですが・・・

A1に会社名のカタカナ。B1に会社名があります。
10行程度すでにデータが入っている状態で
途中行に新たに1行を挿入したのち
増えた行数分(全部で11行)も含めて並べ替えをするという作業を行います。

その場合、マクロで以上の手順を踏むと
1度目はうまくいくのですが
2度目になると相対参照でマクロを設定したにも関わらず
11行目までしかソートされません。
12行目がソートの範囲に入らないのです。

行が増えた分も含めて、すべての行数をソートするには
どのようなVBAを組めばいいのでしょうか?
ご教授ください。

Aベストアンサー

#02です。代替案は後で示しますが、補足文の内容だけでは「論理的に不可能」です。

>途中の3行目に1行挿入後
なぜならこの状態で1行目~11行目が「ひとまとまり」になる条件が書かれていないからです。その条件が明示されない限りVBAでソートする範囲を決定できません。

ですから再度A1:B10、A11:B20が「ひとまとまり」であることを判断する条件を補足してください。(人が目で見てできるなら何らかの条件があるはずです)

代替案として最初にA1:B10、A11:B20にそれぞれ名前定義しておく方法があります。それであれば範囲の途中行に行挿入されてもソートが可能です。定義された名前が「grpA」だとするとソートするVBAは以下のようになります
 Range("grpA").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
  :=xlPinYin, DataOption1:=xlSortNormal

でもこの方法は完全ではありません。それは11行目に挿入が行われた場合、その行はどちらの名前定義にも含まれないからです。従ってソートされません。

#02です。代替案は後で示しますが、補足文の内容だけでは「論理的に不可能」です。

>途中の3行目に1行挿入後
なぜならこの状態で1行目~11行目が「ひとまとまり」になる条件が書かれていないからです。その条件が明示されない限りVBAでソートする範囲を決定できません。

ですから再度A1:B10、A11:B20が「ひとまとまり」であることを判断する条件を補足してください。(人が目で見てできるなら何らかの条件があるはずです)

代替案として最初にA1:B10、A11:B20にそれぞれ名前定義しておく方法が...続きを読む

Q遠近両用コンタクトレンズの使用について

私は乱視が強く、視力は裸眼で0.3程度でハードコンタクトレンズを使用しております。
乱視が極端に強いので視力を抑えて目の疲れを抑えています。

最近、コンタクトレンズを使用しているときに(めがねも同様ですが)
小さい字が見づらくなってきました。
コンタクトを外すと見えるのですが、つけている状態だとよくわからい状態です。

年齢は47歳になったのでそろそろ老眼なのかなと考えております。
このような場合、コンタクトは遠近両用のレンズにしたほうがよいのでしょうか。
乱視が強いのでどうしたらいいかわかりません。

Aベストアンサー

私も、強い乱視で、しかも右目がひどく、いわゆるガチャメです。
コンタクトで、乱視を完全に強制することは無理ですよね。
角度の調整が必要の為、アバウトになると思います。
私も老眼が、進行しています。

色々な、強制方法を試しましたが、全てを満足させることは出来ません。仕事優先か?レジャー優先か?で、強制方法を変えています。
たとえば、車を運転する場合は、近視と乱視を矯正するメガネを使用。
但し、老眼が進んでいるので、矯正視力は1.0で、スピードメータ等が、見える程度です。また、パソコンを使ったり、読書をする時は、乱視のみを矯正をした、めがねを使います。
コンタクトは、近視と乱視を矯正したものと、市販の老眼鏡を併用します。近視と乱視を矯正するコンタクトは、必須アイテムで、サングラスが必要な時に使います。
場合に合わせた、組み合わせが必要かと。。。

QEXCELマクロでファイル名を指定して実行.....

EXCELのマクロでファイル名を指定して実行のラインで実行するように実行をしたいのですがやり方がわかりません。ご存知のかたお教えねがえないでしょうか。

Aベストアンサー

>エクセルのsheetにコマンドボタンを作成し
これはお判かりとして
>そのコマンドボタンを押すことにより
Private Sub CommandButton1_Click()
x = Shell("C:\WINDOWS\calc.exe")
End Sub
の電卓の例をご参考に。


人気Q&Aランキング

おすすめ情報