今だけ人気マンガ100円レンタル特集♪

VB 特定フォルダ内の画像のサムネイル表示
VisualBasic2008 ExpressEditionにてVBを勉強中の者です。
現在作成しようとしているものは指定したフォルダ内の画像を
サムネイル表示し、サムネイルの画像をダブルクリックしたら
拡大表示するものです。
はじめPictureBoxを20個並べて用意してやっていたのですが、
指定されたフォルダ内の画像の数が10枚~50枚を超える場合も
あり、ファイル数に応じて動的にサムネイルを作成・表示する
方法がないかと思いまして質問しました。
同じような質問をgoogle等で調べて見ましたが具体的にどうする
のかわかりませんでした。
よろしくお願いします。

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

A 回答 (2件)

@IT の古い記事ですが、Google のイメージ検索結果を一覧表示する Windows アプリの作成記事があります。


http://www.atmarkit.co.jp/fdotnet/practprog/inde …
一覧表示する部分はカスタムなコントロールを自作しており、サムネイルの大きさも変えられます。
第 1回~第 3回あたりが参考になるかもしれません。
    • good
    • 0
この回答へのお礼

ありがとうございました。
なんとかできそうです。

お礼日時:2010/05/06 17:15

まんま、ファイル数に応じて動的にPictureBoxをNewすればいいと思います。


そのPictureBoxをどうやって表示するかはお好みで。
現在20個並べているところに追加してあげるとか。

文面からするときっと、
1枚目を見つけたら1個目のPictureBoxにサムネイル表示
2枚目を・・・(略)

とやっていると思います。
↓のような流れにすれば良いと思います。
1枚目を見つけたら1個のPictureBoxをNewしてサムネイル設定。
そのPictureBoxをどこに配置するかはお好みで。(Gridのセルとかかな?)
今20個表示できているならきっと簡単です。
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

このQ&Aを見た人はこんなQ&Aも見ています

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

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

Q縮小版のサムネイルの取得(画像ファイル以外で)

エクスプローラーの縮小版で表示されるサムネイルをPictureBox上に表示したいのですが
どのAPIを使用すればよいのでしょうか?
JPG、GIFのサムネイルの取得はGetThumbnailImageで可能ですが、
どのすべてのファイルに対して縮小版で表示されるサムネイルを画像として取得したいのです。

環境はWIndowsXP,Visual Basic 2008 Express Editionです。
VB6であれば、olepro32.dllのOleCreatePictureIndirectを使えばよいみたいなのですが、これに似た方法をVB.Net環境で調べています。

Aベストアンサー

下記が参考になるでしょうか。

http://bbs.wankuma.com/index.cgi?mode=al2&namber=3122&KLOG=12

QListViewコントロールでサムネイル画像を一覧表示するには?

VB初心者です。
.NET TIPSの中に「ListViewコントロールでサムネイル画像を一覧表示するには?」というものがありました
今回、それを利用してサムネイル一覧の表示をしようとして行き詰りました。

作りたいのは以下のものです
○決まったサイズの画像(bitmap)を表示し、その下にファイル名(フルパスでは無い)を表示し、更にその下に元の画像のサイズを表示するようなものを作成したいのですが、作成可能でしょうか?
また、作成可能な場合、どういった方法で作成したら良いか教えて下さい。
行き詰ったのは、第一段階の、サムネイル画像のしたのファイル名の所です。
よく分からずに
ListView1.Items.Add(bmpFiles(i), i)の所を
Dim bmpFileName As String = _
Path.GetFileNameWithoutExtension(bmpFiles(i))
ListView1.Items.Add(bmpFileName)
bmpFileName(ファイル名のみ)に変更したら、ファイル名は表示されるのですが、画像が表示されませんでした。

次に両方書いたのですが画像の下にフルパスその横にファイル名が表示されます。
Dim bmpFileName As String = _
Path.GetFileNameWithoutExtension(bmpFiles(i))
ListView1.Items.Add(bmpFiles(i), i)
ListView1.Items.Add(bmpFileName)
色々調べてみたのですが、思ったような記述が無かったのでここで質問させて頂きました。
拙い質問なので分かり難いかと思いますがアドバイスをよろしくお願いいたします。

VB初心者です。
.NET TIPSの中に「ListViewコントロールでサムネイル画像を一覧表示するには?」というものがありました
今回、それを利用してサムネイル一覧の表示をしようとして行き詰りました。

作りたいのは以下のものです
○決まったサイズの画像(bitmap)を表示し、その下にファイル名(フルパスでは無い)を表示し、更にその下に元の画像のサイズを表示するようなものを作成したいのですが、作成可能でしょうか?
また、作成可能な場合、どういった方法で作成したら良いか教えて下さい。
行き詰っ...続きを読む

Aベストアンサー

n-junです。

画像を表示して、そこにファイル名と画像の(幅と高さ)を表示でしょうか?

ListView1.Items.Add(System.IO.Path.GetFileName(jpgFiles(i)) & vbLf & "幅:" & original.Width _
& " 高さ:" & original.Height, i)

こんな感じなら出来ましたけど、どうでしょう?

Q任意フォルダから画像をすべてエクセルの指定マスに貼り付けをしたい

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるようにしようとすると、かなり難易度が高くお手上げ状態です。
このプログラムをどのように改修すれば可能になるかお教えください。

Sub 図11()

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)

' 貼り付け開始セルを選択
Range("B6").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

End Sub

よろしくおねがいします。
※マクロはほぼ初心者です。大体がネットからコピペをして使っている程度のレベルです。

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるよう...続きを読む

Aベストアンサー

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトしてください。また、DoEvents も入れておきました。
④は、何も手を付けていません。
コメント・アウトした部分で不要なら削除してください。

'//
Sub 図11R()
 'No. 9024507
 Dim strFilter As String
 Dim Filenames() As Variant
 Dim fName As Variant, ext As String
 Dim PIC As Picture
 Dim k As Long, m As Long
 Dim i As Long, j As Long
 Dim cnt As Long
 Dim FirstRng As Range
 Dim r As Range
 Dim Sel_Folder As Object, Sel_Path As String
 cnt = 0 'カウントの初期値
 '貼り付け最初のセル
 Set FirstRng = Range("A2")
 
  Set Sel_Folder = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "フォルダを選択してください", 5)

  If Not Sel_Folder Is Nothing Then
    Sel_Path = Sel_Folder.Self.Path
  Else
   Exit Sub
  End If
 
 ' 「ファイルを開く」ダイアログでファイル名を取得
 ChDir Sel_Path
' strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
' Filenames = Application.GetOpenFilename( _
' FileFilter:=strFilter, _
' Title:="図の挿入(複数選択可)", _
' MultiSelect:=True)
 fName = Dir("*.*", vbNormal)
 Do While fName <> ""
  If fName <> "." And fName <> ".." Then
   ext = Mid(fName, InStrRev(fName, ".") + 1)
   If InStr(1, "jpg,jpeg,gif,bmp,png", ext, 1) > 0 And Not fName Like "#*" Then
    cnt = cnt + 1
    DoEvents
    ReDim Preserve Filenames(1 To cnt)
    Filenames(cnt) = fName
    ''安全のため(上限を設定)
    If cnt > 100 Then Exit Do
   End If
  End If
  fName = Dir()
 Loop
 If cnt = 0 Then Exit Sub
 
 ' ファイル名をソート
 Call BubbleSort_Str(Filenames, True, vbTextCompare)
 
 '' 貼り付け開始セルを選択
 'Range("B6").Select
 
 ' マクロ実行中の画面描写を停止
 Application.ScreenUpdating = False
 ' 順番に画像を挿入
 k = LBound(Filenames)
 m = UBound(Filenames)
 
 For j = 1 To Int(m / 4) + Abs(m Mod 4 > 0)
  For i = 1 To 4
   Set PIC = ActiveSheet.Pictures.Insert(Filenames(k))
   Set r = FirstRng.Cells(1 + (j - 1) * 2, i)
   
   '-------------------------------------------------------------
   ' 画像の各種プロパティ変更
   '-------------------------------------------------------------
   With PIC
    .Top = r.Top ' 位置:アクティブセルの上側に重ねる
    .Left = r.Left ' 位置:アクティブセルの左側に重ねる
    .Placement = xlMove ' 移動するがサイズ変更しない
    .PrintObject = True ' 印刷する
   End With
   With PIC.ShapeRange
    .LockAspectRatio = msoTrue ' 縦横比維持
    ' 画像の高さをアクティブセルにあわせる
    ' 結合セルの場合でも対応
    .Height = r.MergeArea.Height
   End With
   
   ' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
   ' ActiveCell.Offset(5).Select
   
   Set PIC = Nothing
   k = k + 1
   If k >= m Then Exit For
  Next i
 Next j
 Application.ScreenUpdating = True
 ChDir ThisWorkbook.Path
End Sub

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトし...続きを読む

QVBAで画像を表示する方法

VBA初心者です。ExcelのVBAでプログラミングの練習をしています。
早速ですが質問させてください。
ユーザーフォーム上にコマンドボタンをクリックすることにより画像を表示させることはできるのですが、これをユーザーフォームを開いた瞬間に自動的に表示させる方法はないのでしょうか?

ちなみに現在は以下のようにしています。
Private Sub CommandButton1_Click()
Image1.Picture = LoadPicture(" ")
End Sub

インターネットで調べてみても見つからないので質問させてもらいました。分かりにくい説明でしたらすみません。

Aベストアンサー

UserFormのinitializeイベントかActivateイベントを使ってください。

Private Sub UserForm_Initialize()
 Image1.Picture = LoadPicture("C:\aaa.jpg")
End Sub

または、

Private Sub UserForm_Activate()
 Image1.Picture = LoadPicture("c:\aaa.jpg")
End Sub

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q エクセルで写真をサムネール表示するマクロを組んでいます。

 エクセルで写真をサムネール表示するマクロを組んでいます。
ところが、Sheetに挿入した写真をコピーするところで
エラーが出ます。

いろいろ試行錯誤を繰り返したところ
コマンドボタンなどのボタン類を張り付けてあるSheetでは、
コピーできないことが分かりました。

 具体的なマクロサンプルを挙げておきますので、
同じようなことが起こるか試してもらえませんでしょうか。
またその原因も教えていただければ幸いです。

Sub test()
Dim x As Variant
x = Application.GetOpenFilename("jpgFiles,*.jpg")
If VarType(x) = vbBoolean Then Exit Sub
ActiveSheet.Pictures.Insert(CStr(x)).Select
Selection.Width = 162
Selection.Height = 100
Selection.Copy
ActiveSheet.Paste
End Sub

 上のtest()マクロをコマンドボタンの有るSheetと無いSheetで
実行すると、
◎コマンドボタンの有るSheet ⇒ Selection.Copyで
    『PictureクラスのCopyメソッドが失敗しました』というエラーが出る。
◎コマンドボタンの無いSheet ⇒ エラーが出ずコード通り実行される

 因みに、
エクセル2007は、(12.0.6425.1000)SP2 MSO(12.0.6529.5000)
OSは、XP HomeEdition Version 2002 Service Pack 3
です。

 エクセルで写真をサムネール表示するマクロを組んでいます。
ところが、Sheetに挿入した写真をコピーするところで
エラーが出ます。

いろいろ試行錯誤を繰り返したところ
コマンドボタンなどのボタン類を張り付けてあるSheetでは、
コピーできないことが分かりました。

 具体的なマクロサンプルを挙げておきますので、
同じようなことが起こるか試してもらえませんでしょうか。
またその原因も教えていただければ幸いです。

Sub test()
Dim x As Variant
x = Application.GetOpenFilename("jpgFiles,*.j...続きを読む

Aベストアンサー

とりあえずPictures.Copyの問題はUpdateで解決の方向のようで
良かったですね。

先にも書きましたがPicturesオブジェクトについては
便利なのですが、隠しオブジェクトという事もあり、
Pictures.InsertもMicrosoft非推奨のようです。
http://moug.net/faq/viewtopic.php?t=51292
今後はShapes.AddPictureに切り替えていく事なども検討の必要が
出てくるのかもしれませんね。

>P.S
の現象については結構ありがちです。
マクロ記録のままのコードを実行してもエラーが出るケース。
Selectionが絡んでたりする事が多いでしょうし。
そんな事もあるんだ、
くらいであまり気にされないほうが良いかと。

現状のトラブルについては、
念の為2007のセキュリティレベルを確認してみる事と、
『コントロールは作成されていないため、デザインモードを終了できません』
これをキーワードにgoogle検索して、
いろんな情報を探ってみたほうが良いかもしれません。

BookあるいはSheetの破損の可能性..という情報もありますが、
確認してみたほうが良いと思えるのが
http://naganonopapa.blog102.fc2.com/blog-date-20100610.html
この情報。KB978262に原因があるのでは、という事です。
もちろん環境によって全く関係ないかもしれませんので参考まで。

ではでは。 :)

とりあえずPictures.Copyの問題はUpdateで解決の方向のようで
良かったですね。

先にも書きましたがPicturesオブジェクトについては
便利なのですが、隠しオブジェクトという事もあり、
Pictures.InsertもMicrosoft非推奨のようです。
http://moug.net/faq/viewtopic.php?t=51292
今後はShapes.AddPictureに切り替えていく事なども検討の必要が
出てくるのかもしれませんね。

>P.S
の現象については結構ありがちです。
マクロ記録のままのコードを実行してもエラーが出るケース。
Selectionが絡んでたりする事が...続きを読む

QエクセルVBAで画像を貼り付ける座標設定方法は?

Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。
そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。
オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか?

Sub TEST()
Sheets("FACE").Shapes("シンボルマーク").Copy
ActiveSheet.Range("K12").Select
ActiveSheet.Paste
End Sub

Aベストアンサー

#1です。
>この場合、ファイルをエクセルにくっつけて渡すなんてこと
>はできないものでしょうか?(別々にではなくあくまでエク
>セルのブックに付属した形で)
Excelのブックに付属した形にするなら、コピーペーストする方がいいと思います。一旦挿入した画像を別途保存するのは、簡単には出来ないと思います。

複数のシートで同じような作業をするなら、次のような方法も考えられます。
Function CpyMrk(MrkNM As String, myTop As Single, myLeft As Single)
Sheets("FACE").Shapes(MrkNM).Copy
ActiveSheet.Paste
ActiveSheet.Shapes(MrkNM).Top = myTop
ActiveSheet.Shapes(MrkNM).Left = myLeft
End Function

Sub test()
CpyMrk "シンボルマーク", 10, 10
End Sub

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

Qエクセルに画像(JPG)を取り込む作業を簡単にしたい!!

エクセルに画像(JPG)を取り込むときに、その画像のファイル名をセルに入力するとその画像が取り込めますか??
毎回、挿入から画像のある場所を指定してやっているととっても時間がかかります・・・。
簡単にできる方法はないでしょうか??
マクロがわからないので、やさしく教えてもらえると助かります。

Aベストアンサー

画像挿入ダイアログをマクロで出したいなら、

Sub Test1()
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

単純に図の挿入ボタンをユーザー設定でツールバーに置いておくのと変わりませんが。

他には、
例えば画像のフルパスを入力したセルを選択し、下記のようなマクロを実行すると画像が挿入されます。

Sub Test2()
Dim pict
On Error Resume Next
  If Dir(ActiveCell.Text) = "" Then Exit Sub
  Set pict = ActiveSheet.Pictures.Insert(ActiveCell.Text)
  pict.Top = ActiveCell.Offset(0, 1).Top
  pict.Left = ActiveCell.Offset(0, 1).Left
End Sub

画像ソフトからのコピー&ペーストは止めた方が良いと思います。
挿入-図と比べて、同じ画像を取り込んでも画像の形式に関係なく出来上がるExcelのファイルサイズがまったく異なってきますので。

> どうしてこんな簡単なことができないのか・・。と思ってしまいます。

Excelは画像管理ソフトじゃないので、そんな機能は必要ないという判断なのでしょう。

画像挿入ダイアログをマクロで出したいなら、

Sub Test1()
  Application.Dialogs(xlDialogInsertPicture).Show
End Sub

単純に図の挿入ボタンをユーザー設定でツールバーに置いておくのと変わりませんが。

他には、
例えば画像のフルパスを入力したセルを選択し、下記のようなマクロを実行すると画像が挿入されます。

Sub Test2()
Dim pict
On Error Resume Next
  If Dir(ActiveCell.Text) = "" Then Exit Sub
  Set pict = ActiveSheet.Pictures.Insert(ActiveCell.Text)
  pict.T...続きを読む

Q複数の画像ファイルを挿入したい

工事の仕事をしています。
報告書をエクセルで書いて出すのですが、
現場の写真を大量に撮影して貼り付けなければなりません。

「挿入」→「ファイルから」で一枚一枚貼り付けているのですが手間でなりません。

デジカメで撮影した写真なのでファイル名は連番です。
一括でワークシートにズラッと並べて挿入することはできないのでしょうか?

週末1-200枚の写真を貼る為に残業するのは堪えます。
良い知恵をお貸し下さい。

Aベストアンサー

工事写真票の作成ですか?報告書の提出時期ですものね。(^^;)

工事写真ということで、次の点が重要になるかと思います。

1. 貼付けられる順番
  工事の様子を時間を追って撮影している場合、順番が重要です。
2. リサイズの問題
  工事写真は正確性が求められます。リサイズする場合、縦横比を固定すべきです。

1と2をクリアしつつ、貼付けを楽にするには、EXCELではマクロしか解決方法がありません。個人的にはVIXをお勧めしますが、一応EXCELでのマクロをアップします。貼付け後のサイズはセルの高さにあわせています。必要があれば、コードをカスタマイズして下さい。

ただ、他の方からもご指摘があるとおり、EXCELに200枚の画像は無茶ですね。複数のブックに切り分けましょう。

なお、マクロ[InsertPictures]は#2.papayukaさんのコードをかなり拝借しておりますし、配列のソートプログラムも以前どこかで教えて頂いたものです。クイックソートの方が早いのですが、長くなるので、バブルソートで済ませています。


以下コード。

Option Explicit
Sub InsertPictures()
  
  Dim fName As Variant
  Dim i As Long
  Dim Pict As Picture

  fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True)
  If IsArray(fName) Then
    Application.ScreenUpdating = False
    '配列に格納されたファイル名をソート
    BubbleSort fName, True
    For i = 1 To UBound(fName)
      Set Pict = ActiveSheet.Pictures.Insert(fName(i))
      With Pict
        .TopLeftCell = ActiveCell
        .ShapeRange.LockAspectRatio = msoTrue
        'どちらかをコメントアウト
        .ShapeRange.Height = ActiveCell.Height 'セルの高さリサイズ
        '.ShapeRange.Width = ActiveCell.Width 'セルの幅にリサイズ
        ActiveCell.Offset(0, 1) = fName(i) 'ファイル名書込み
      End With
      ActiveCell.Offset(2, 0).Activate
      Application.StatusBar = "処理中:" & i & "/" & UBound(fName) & "枚目"
    Next i
  End If
  With Application
    .StatusBar = False
    .ScreenUpdating = True
  End With
  Set Pict = Nothing
  MsgBox i & "枚の画像を挿入しました", vbInformation

End Sub

'値の入替え
Public Sub Swap(ByRef Dat1 As Variant, ByRef Dat2 As Variant)

  Dim varBuf As Variant
  varBuf = Dat1
  Dat1 = Dat2
  Dat2 = varBuf

End Sub

'配列のバブルソート
Public Sub BubbleSort(ByRef aryDat As Variant, _
  Optional ByVal SortAsc As Boolean = True)

  Dim i As Long
  Dim j As Long
  For i = LBound(aryDat) To UBound(aryDat) - 1
    For j = LBound(aryDat) To LBound(aryDat) + UBound(aryDat) - i - 1
      If aryDat(IIf(SortAsc, j, j + 1)) > aryDat(IIf(SortAsc, j + 1, j)) Then
        Call Swap(aryDat(j), aryDat(j + 1))
      End If
    Next j
  Next i

End Sub

工事写真票の作成ですか?報告書の提出時期ですものね。(^^;)

工事写真ということで、次の点が重要になるかと思います。

1. 貼付けられる順番
  工事の様子を時間を追って撮影している場合、順番が重要です。
2. リサイズの問題
  工事写真は正確性が求められます。リサイズする場合、縦横比を固定すべきです。

1と2をクリアしつつ、貼付けを楽にするには、EXCELではマクロしか解決方法がありません。個人的にはVIXをお勧めしますが、一応EXCELでのマクロをアップします。貼付け後のサイズはセ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング