ビジュアルなフォーマットのコントロールは、意外に難しいものだと感じてしまう ー 画像分割（VBAマクロ）

         

VBAで、もぐらたたきゲームを作るのにユーザーフォームを使おうとしました。

実際、モグラのアイコンを升目に並べるて、ランダム表示まではできるのです。

ですが、自分の能力の無さなのか、モグラをクリックで叩くとエラーの発生だ。

’Global’オブジェクトのエラーメッセージが出て来て、皆目見当がつきません。

多分、ループ処理中にApplication.Waitの待機時間を作ったのが、問題らしい。

元々、ユーザーフォームのコマンドボタンに画像を載せてボタンを表示させる。

そこでクリックすると、得点になって叩いたポイントを加算すると言う仕組み。

以前、ワークシート上で作成できたので、ちょっと欲張ってみただけのことだ。

なので、できなければそれも良しという点で、今度はアイデアの転換をします。

まあ、升目に画像を並べて表示できたのなら、画像を分割して升目に表示です。

次に、タイル状になった画像をランダムに一つずつ表示したら、短時間で消す。

漢字当てとか道具当てとか、テレビのクイズ番組でも出題されていた手法だな。

ただ、一つの画像を升目に分割する方法方が分からないので、ネットで探した。

一つだけあって、これがなかなかに簡潔にまとまっていたので、紹介しますね。

ここでワークシートに分割して貼られた画像は、シェイプのオブジェクトだな。

だから、これをランダムに表示していくような設定がなかなにできないのです。

コード記述がどこか間違っているのかもしれませんが、これからの課題なんだ。

というわけで、シェイプオブジェクトのコントロールは、目新しくて難しいな。

ネットで紹介されているプロシージャのコードを、実際にVBエディターにコピペして起動させても、エラーが出たりとその理由を探して、適切なコードを探さねばならんのですが、とりあえずは分割までできたから、紹介させてもらうと言うことなのでした。

※サンプルコード

Sub PictDivisionGo()

Dim OrgnlPict As Object, DvddPict As Shape

Dim i As Integer, j As Integer, Nr As Integer, PckUpFle As String

Dim OrgnlPictWdth As Single, OrgnlPictHght As Single, DvddWdth As Single, DvddHght As Single

Dim HrzntlDvddNr As Integer, VrtclDvddNr As Integer

  Const Chnk As Integer = 3 '分割写真の間の隙間

      PckUpFle = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg")

      If PckUpFle = "False" Then Exit Sub

          Set OrgnlPict = ActiveSheet.Pictures.Insert(PckUpFle) '元図をシート貼付け

        With OrgnlPict

          .Top = 5 '上から5ポイント、左から5ポイントの位置

           .Left = 5

        End With

         HrzntlDvddNr = Application.InputBox("水平の分割数", "0以外の数値を入力")

           VrtclDvddNr = Application.InputBox("垂直の分割数", "0以外の数値を入力")

             OrgnlPictWdth = OrgnlPict.Width

               OrgnlPictHght = OrgnlPict.Height

                 DvddWdth = OrgnlPictWdth / HrzntlDvddNr '分割された図の幅

                   DvddHght = OrgnlPictHght / VrtclDvddNr '分割された図の高さ

                OrgnlPict.Copy

                  Nr = 1

For i = 1 To VrtclDvddNr '元図を垂直分割数で割る繰り返し

  For j = 1 To HrzntlDvddNr '元図を水平分割数で割る繰り返し

    ActiveSheet.Paste

      Selection.Name = "DvddPict" & Nr

        With ActiveSheet.Shapes("DvddPict" & Nr) '分割図の番号付き名称付け

          .Top = Chnk * i

        .Left = Chnk * j

              With .PictureFormat

                .CropTop = DvddHght * (i - 1) 'トリミングする上部位置

                  .CropBottom = DvddHght * (VrtclDvddNr - i) 'トリミングする下部位置

                  .CropLeft = DvddWdth * (j - 1) 'トリミングする図の左部位置

                .CropRight = DvddWdth * (HrzntlDvddNr - j) 'トリミング図の右部位置

              End With

            End With

      Nr = Nr + 1

  Next

Next

  OrgnlPict.Delete

End Sub

お願い：画素数の大きな画像は、途中でエラーが出るので注意してください。

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村