Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1253 / 13645 ツリー ←次へ | 前へ→

【75409】順序よく、エクセルから画像を取り出す クリプ 14/3/21(金) 11:35 質問[未読]
【75436】Re:順序よく、エクセルから画像を取り出す ちび坊主 14/3/25(火) 13:27 回答[未読]
【75437】Re:順序よく、エクセルから画像を取り出す ちび坊主 14/3/25(火) 16:07 回答[未読]
【75446】Re:順序よく、エクセルから画像を取り出す クリプ 14/3/31(月) 6:30 回答[未読]
【75447】Re:順序よく、エクセルから画像を取り出す ちび坊主 14/3/31(月) 10:22 回答[未読]
【75448】Re:順序よく、エクセルから画像を取り出す クリプ 14/3/31(月) 12:50 お礼[未読]

【75409】順序よく、エクセルから画像を取り出す
質問  クリプ  - 14/3/21(金) 11:35 -

引用なし
パスワード
   ブックに写真を沢山貼り付け、写真アルバムとして使っています。
全写真をJPEGファイルとして取り出したいとおもいます。
例えば、以下のような方法でできることはできるのですが、
t tp://zuvuyalink.net/nrjlog/archives/1007
できたJPEGの名前がテキトーなようです。

最も上左に貼り付けてある写真から、順に名前をつけたいと思います。
最も上左にある写真がImage001、
2番目の写真がImage002・・・・といった感じです。

どうぞよろしくお願いいたします。
Windows7でエクセル2010を使っています。

【75436】Re:順序よく、エクセルから画像を取り出す
回答  ちび坊主  - 14/3/25(火) 13:27 -

引用なし
パスワード
   こんにちは。

試した感じでは、画像のZorder順で名付けられるようです。

Sub test()
 Dim PicList As Object
 Dim Pic As Picture
 Dim i As Long
 
 
 Set PicList = CreateObject("System.Collections.SortedList")

 For Each Pic In ActiveSheet.Pictures
  PicList.Add Pic.Top, Pic.Name
 Next
 
 For i = 0 To PicList.Count - 1
  ActiveSheet.Pictures(PicList.GetByIndex(i)).ShapeRange.ZOrder msoBringToFront
 Next
 
 Set PicList = Nothing
End Sub

たたき台程度で。

画像のTopと名前を取り込み、Top順で名前を並べ替えて、
その名前順でZorderを変えています。

同じTopの画像があった場合には、Indexが若い方は無視されます。

【75437】Re:順序よく、エクセルから画像を取り出す
回答  ちび坊主  - 14/3/25(火) 16:07 -

引用なし
パスワード
   昔作った、どこにでもあるSortで横位置にも対応してみた。

Sub test02()
 Dim Pic As Picture
 Dim i As Long
 ReDim PicList(0 To ActiveSheet.Pictures.Count - 1, 0 To 2) As Variant
 
 For Each Pic In ActiveSheet.Pictures
  PicList(i, 0) = Pic.Name
  PicList(i, 1) = Pic.Left
  PicList(i, 2) = Pic.Top
  i = i + 1
 Next
 
 Call BubbleSort(PicList, 1)
 Call BubbleSort(PicList, 2)
 
 For i = 0 To ActiveSheet.Pictures.Count - 1
  ActiveSheet.Pictures(PicList(i, 0)).ShapeRange.ZOrder msoBringToFront
 Next
 
End Sub


Sub BubbleSort(ByRef Ary() As Variant, ByVal key As Long)
 Dim swap As Variant
 Dim i As Long
 Dim j As Long
 Dim k As Long
 
 For i = LBound(Ary, 1) To UBound(Ary, 1)
  For j = UBound(Ary, 1) To i Step -1
   If Ary(i, key) > Ary(j, key) Then
    For k = LBound(Ary, 2) To UBound(Ary, 2)
     swap = Ary(i, k)
     Ary(i, k) = Ary(j, k)
     Ary(j, k) = swap
    Next
   End If
  Next
 Next
End Sub

左上から右へと並び替えてます。
下へ向かうなら、
Call BubbleSort(PicList, 2)
Call BubbleSort(PicList, 1)
キーの順番を変えてください。

【75446】Re:順序よく、エクセルから画像を取り出す
回答  クリプ  - 14/3/31(月) 6:30 -

引用なし
パスワード
   ▼ちび坊主さん、御回答いただきありがとうございます。
年度末のバタバタのため、返信が遅くなり申し訳ございません。
今後は落ち着きますので、極端に返信が遅くなることはないと思います。
引き続き、御指導ください。

>昔作った、どこにでもあるSortで横位置にも対応してみた。
ありがとうございます。
当方VBA知識が乏しく、使い方がよくわかりません。
以下のようにしたのですが、
(表面上は)何の動作もしてないように見えます。。。
どうも、この方法↓は違うように思います。。。
・まず、写真アルバムブックを立ち上げる。
・Sub test02()とSub BubbleSort(ByRef Ary() As Variant, ByVal key As Long)を
標準モジュールに貼り付ける。
・Sub test02()をF5で実行させる。

すみません、使い方についても御指導ください。

【75447】Re:順序よく、エクセルから画像を取り出す
回答  ちび坊主  - 14/3/31(月) 10:22 -

引用なし
パスワード
   このコードは画像の上下(ZOrder)の順番を入れ替えているだけなので、
保存、拡張子をzipに変更、解凍は手動で。

【75448】Re:順序よく、エクセルから画像を取り出す
お礼  クリプ  - 14/3/31(月) 12:50 -

引用なし
パスワード
   ▼ちび坊主 さん:
>このコードは画像の上下(ZOrder)の順番を入れ替えているだけなので、
>保存、拡張子をzipに変更、解凍は手動で。
ありがとうございました!!!
シートにあるような順番で画像ファイルが作成されました!
どうも有難うございました、解決しました!!!

1253 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free