Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6891 / 76732

←次へ　｜　前へ→


	【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)
キーの順番を変えてください。

4 hits

▼

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