任意の数で写真を分割する

以前に写真を2分割するでも紹介したが、今回は縦横ともに任意の数で写真を分割してくれるマクロを。
例えば、縦2、横3で分割した場合は、下図のようになる。
e0080122_1372513.gif

細かなエラー処理などは施していないが、例により糞の役にも立ちそうにないマクロのためこのまま実行してみる。

Sub 分割()
 Dim 元図 As Object
 Dim 各々図 As Shape

 Dim i As Integer
 Dim j As Integer
 Dim num As Integer
 Dim myFname As String

 'Dim x As Integer, y As Integer
 Dim 元図幅 As Single, 元図高 As Single
 Dim 分割幅 As Single, 分割高 As Single

 Const 隙間 As Integer = 5
 Dim 横分割数 As Integer, 縦分割数 As Integer

  Call mySdel

  myFname = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg")
  If myFname = "False" Then Exit Sub
   Set 元図 = ActiveSheet.Pictures.Insert(myFname)
     With 元図
       .Top = 5
       .Left = 5
     End With
  横分割数 = Application.InputBox("横何分割?", "0以外の数値を入力")
  縦分割数 = Application.InputBox("縦何分割?", "0以外の数値を入力")

  元図幅 = 元図.Width
  元図高 = 元図.Height
  分割幅 = 元図幅 / 横分割数
  分割高 = 元図高 / 縦分割数
    元図.Copy
    num = 1

  For i = 1 To 縦分割数
    For j = 1 To 横分割数
      ActiveSheet.Paste
       Selection.Name = "各々図" & num
      With ActiveSheet.Shapes("各々図" & num)
        .Top = 隙間 * i
        .Left = 隙間 * j
        With .PictureFormat
          .CropTop = 分割高 * (i - 1)
          .CropBottom = 分割高 * (縦分割数 - i)
          .CropLeft = 分割幅 * (j - 1)
          .CropRight = 分割幅 * (横分割数 - j)
        End With
     End With
       num = num + 1
    Next
  Next
      元図.Delete
End Sub
上記の構文中に出てくるサブルーチンはあえてここで書く必要もないと思ったので、書かなかった。
また縦、横ともに10ぐらいの数値は大丈夫だがそれ以上になると処理に時間がかかってエクセルが止まってしまう場合がある。
しかし、目的のものが出来たのでよしとする。
[PR]
by slayer0210 | 2006-01-13 13:25 | マクロ


<< 任意の範囲に写真を挿入する 写真を2分割する >>