[[20141125005151]]　『vba 画像のトリミング』（ブンちゃん）　ページの最後に飛ぶ

『vba 画像のトリミング』（ブンちゃん）

今晩は初めまして悩んでいます助けて下さい、２００枚ぐらいの
A4に２０個ほどの小さい消しゴムほどの商品の写真がありその一つ一つの検索ファイルを
作っています、userformにimageを配置して類似のものを検索して配列しようと考えていますがimageに呼び出しサイズ変更まで出来ましたが指定したleft topまでの移動が解りません、お願いします。

 Dim pcname
 Dim picname
  Sheet1.Activate
     pcname = "D:\カタログ.gif"
  With Image1
      Image1.AutoSize = True
      Image1.Picture = LoadPicture(pcname)
          .Left = 20
          .Top = 50
  End With
  With Image1
      .Width = 50
      .Height = 100
  End With
お返事お待ちしています、くれぐれもお願いします、

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

Sheet1.Shapes.AddPicture "D:\カタログ.gif", msoFalse, msoTrue, 20, 50, 50, 100
（???） 2014/11/25(火) 08:40

↑AddPictureはシートにシェープを貼り付けるので、今回のユーザーフォームのImageにセットする場合には使えないかな？

ところで、アップされたコード、いくつか疑問があるなぁ。

・サイズ変更まで出来ましたが

ほんと？

・With Image1/End With

これは、なにをしているつもり？

・以下は何をしているつもり？

  .Left = 20
  .Top = 50
  .Width = 50
  .Height = 100

目的とコードがあっていない気がしてコメントもしづらいけどImageコントロールの
PictureAlignmentプロパティを調べるとImage内での画像のセット位置について
ヒントがあるかも。

http://www.excel-vba.net/excel-userform-005.html

１６：５７追記

PictureSizeModeプロパティ　なんかも、今回のテーマには便利かも。

（通りすがり） 2014/11/25(火) 11:49

Sheet1.Activateとあったので、シートと勘違いしました。フォームですね。改めて、横に10ずつ並べる例。
(ちなみに、AutoSizeプロパティはFalseにしておかないと、サイズ変更できないかと？)

 Private Sub UserForm_Initialize()
    Dim C As Control
    Dim iCou As Long

    For Each C In Controls
        If C.Name Like "Image*" Then
            With C
                .Picture = LoadPicture("D:\カタログ.gif")
                .Move 20 + 50 * (iCou Mod 10), 50 + 100 * Int(iCou / 10), 50, 100
                iCou = iCou + 1
            End With
        End If
    Next
End Sub
（???） 2014/11/25(火) 17:32

御返事有難う御座います、説明不足で申し訳ありません。
Private Sub userform_initialize()　　　　’記載していませんでした　
　Dim pcname
　 Dim picname

  Sheet1.Activate　　　　　　　　　　　　、不要　シートにデータを書き込んでいますので
     pcname = "D:\カタログ.gif"
  With Image1
      Image1.AutoSize = True　　　　　　’falseの間違いでした
      Image1.Picture = LoadPicture(pcname)
          .Left = 20　　　　　　　　　　’userform内のimage位置　　　
          .Top = 50　　　　　　　　　　　’userform内のimage位置
  End With　　　　　　　　　　　　　　　’不要
  With Image1　　　　　　　　　　　　　　’不要
      .Width = 50　　　　　　　　　　　　’imageの横サイズ
      .Height = 100　　　　　　　　　　　’imageの縦サイズ
  End With
End Sub

ユーザーフォームのimageにPictureを貼り付け、サイズ変更しただけです、imageに見えているのは画像の
左上から右に５０ピクセル下に１００ピクセルです、この５０×１００のimageを画像の例えば左から２００ピクセル、上から２００ピクセルに移動して、
一つの商品を表示をしたいのですが無理でしょうか
どうかお願いします。

（ブンちゃん） 2014/11/25(火) 21:01

 Imageコントロールだけでは、難しいので・・・・。

 １　画像の加工をシート上で行う
     対象画像をシート上に表示させ、画像のトリミングと位置決定を行い、表示画像を決定する

 ２　シート上の画像をユーザーフォームのImageコントロールに表示させる
     簡単なのは、Chartから、一度、画像をJPGに保存して、再度、ユーザーフォームのImageコントロール
     にLoadPictureを使って表示させる

     難しいけど、APIを使ってクリップボード周りでユーザーフォームのImageコントロール
     に表示させる

 ２は、例題があると思います。

 １をマクロの記録などを使って、完成させt見てください

（ichinose） 2014/11/26(水) 06:54

Imageコントロールのプロパティでは、端か中央しか指定できないので、これを指定座標でトリミングしたい、という主旨でしたか。
以下のように実現できませんか？画像加工する必要がないので、簡単かと思います。

・フォームにFrameコントロールを貼ります。
・Frame内にImageコントロールを貼ります。（Image1を切り取り、Frame選択状態で貼り付けてもOK）
・AutoSizeプロパティはTrue。
・Frame位置を移動すると、Imageも追従することを確認。
・FrameのCaptionプロパティの文字を消します。
・マクロでは、Image1.Move -200, -200 のように、トリミング開始位置分引いて指定。
（???） 2014/11/26(水) 10:26

有難う御座います、ichinoseさんシートに表示は出来ていまして、その後の処置が分かりませんでしたが、
もう一度保存すれば解決してたんですね、でも今回（？？？）さんのやり方で行こうと思います、
お二人様有難うございました、助かりました。
（ブンちゃん） 2014/11/26(水) 21:50

[[20120310233201]]

 ↑ここで　Chartを使っての画像の保存（ichinoseの投稿）、

  APIを使ってのユーザーフォームへの画像の移行（マナさんの投稿）がありますから、参考にしてください

 Frameで不要な部分を隠すという手法、素晴らしいですね！！

（ichinose） 2014/11/27(木) 07:00

シートに表示までです。

Private Sub CommandButton6_Click()

   If Cells(1, 14) > 0 Then
        For n = 1 To Cells(1, 14)
           For i = 1 To sheet2.Cells(1, 9)
              If Cells(n, 17) = sheet2.Cells(2 + i, 1) And Cells(n, 18) = sheet2.Cells(2 + i, 2) Then
                 For j = 1 To 5
                  Cells(n, 26 + j) = sheet2.Cells(2 + i, 2 + j)
                 Next j
                i = sheet2.Cells(1, 9) + 1
              End If
            Next i
        Next n
  End If
  For i = 1 To Cells(1, 14)
  If i = 1 Then
           Cells(1, 33) = Cells(1, 30)
           Cells(1, 34) = Cells(1, 31)
     End If
  If i > 1 Then
          Cells(i, 33) = Cells(i - 1, 33) + Cells(i, 30) + 20
          If Cells(1, 34) < Cells(i, 31) Then Cells(1, 34) = Cells(i, 31)
     End If
 Next i
Dim myPic As Shape, myShape As Shape
Dim dbl_mypicW As Double, dbl_mypicH As Double
Dim dbl_myShapeW As Double, dbl_myShapeH As Double
Dim pname
Dim picname
Dim image(10)

Sheet1.Activate
For i = 1 To Cells(1, 14)
Cells(i, 37) = Len(Cells(i, 27))
Cells(i, 38) = "H:\キャスト３" & Right(Cells(i, 27), Cells(i, 37) - 14)

picname = Cells(i, 38)
ActiveSheet.Pictures.Insert(picname).Select
Selection.Name = "pname"
Set myPic = ActiveSheet.Shapes("pname")

Cells(i, 36) = myPic.Width '写真の幅
Cells(i, 37) = myPic.Height '写真の高さ

dbl_CropRight = Cells(i, 36) - Cells(1, 28) - Cells(1, 30)
dbl_CropLeft = Cells(1, 28)
dbl_CropTop = Cells(1, 29)
dbl_CropBottom = Cells(i, 37) - Cells(1, 29) - Cells(1, 31)
With myPic

    .PictureFormat.CropRight = dbl_CropRight
    .PictureFormat.CropLeft = dbl_CropLeft
    .PictureFormat.CropTop = dbl_CropTop
    .PictureFormat.CropBottom = dbl_CropBottom
End With

Set myPic = Nothing
Set myShape = Nothing

    Next i

End Sub
（ブンちゃん） 2014/12/31(水) 03:23

・コードの前半はきちんとインデントがつけられているけど、後半はめちゃくちゃなのはなぜ？
・Cells(i, 36)　といった横着をせず、Cells(i, 36).Value といったように、対象にしているプロパティを明確に記述しよう。

（通りすがり） 2014/12/31(水) 12:05

すみません後半は他のログを参考にコピペしたもので、、、
先にミスで１通のコメントが送られて無い事に気がつきました、
通りすがりさん見て下さって有難う御座います、
お願いします、シートにデータを読み込み例が５個ほどがあり
商品名と画像を表示したいと模索していましたが、userformにimageプラスframeですと、１個では綺麗に出来るのですが、複数になると前の画像が残るのです、つまり１枚のA5の台紙を複数の窓で見てる形になり、
目的の商品が表示できないので、今度先のコメントのマクロでsheetに並べようと考えましたが、同じ台紙を
呼び込むとやはりトリミングが取り消されるため、画像を仮のファイルに保存再度呼び込むしか無いのかと、
参考に他のスレを見ても良く解りません何とかお願いします。
（ブンちゃん） 2015/01/01(木) 01:14

 >１個では綺麗に出来るのですが、複数になると前の画像が残るのです、
 >つまり１枚のA5の台紙を複数の窓で見てる形になり、目的の商品が表示できない

 少し試してみましたが、再現が出来ません。

 以前、Imageコントロールを使用した時に、近いだろう不具合があった記憶があります（Excel2000）が、
 その時は、　
 PictureプロパティにLoadPicture関数を使って当該画像ファイルをセットする前に

 Image1.picture=nothing

 又、Imageコントロールを何かの拍子にクリックした後に画像が残る現象が発生しているので

 Private Sub Image1_Click()
    Image1.Visible = False
    DoEvents
    Image1.Visible = True
 End Sub

 なんてコードを試していました。

 こんなことで対処できたことを覚えていますが・・・・。同じ現象か否かはわかりませんが。

 不具合現象が再現できる　再現手順書を記述してください。

 ユーザーフォームにどんなコントロールを配置する　からの記述で始まり、　コードや　
 現象が再現できる操作手順の記述の事です。

（ichinose@今年もよろしくです） 2015/01/05(月) 05:19

表示更新がうまくいかない場合、グラフィックアクセラレータのドライバを新しくすると直る場合が多いです。確認してみてください。
（???） 2015/01/05(月) 08:47

ichinose@さん、今年もお世話になります。
今日以下のようにマクロを書き変えたら出来るようになりました、ただし未熟な私にはIF文でしか分岐出来ません、例えばimage(i)のようなことは不可能でしょうか。

Dim pcname

  With UserForm6
           .Top = 150
           .Left = 200
   End With

 For i = 1 To Cells(1, 14)

 If i = 1 Then
      pcname = "D:\キャスト\台帳１.gif"
      Image1.AutoSize = True
      Image1.Picture = LoadPicture(pcname)
      Image1.Move -Cells(i, 31), -Cells(i, 30) + 10

        With Frame1

                .Top = 20
                    If i > 2 Then
                      .Left = Cells(i, 37) + 20
                     Else
                      .Left = 20
                    End If

                .Width = Cells(i, 32)
                .Height = Cells(i, 33) + 20
                .Caption = "No." & Cells(i, 17)
        End With
 End If

 If i = 2 Then
       pcname = "D:\キャスト\台帳１.gif"
       Image2.AutoSize = True
       Image2.Picture = LoadPicture(pcname)
       Image2.Move -Cells(i, 31), -Cells(i, 30) + 10

         With Frame2

                .Top = 20
                    If i > 1 Then
                        .Left = Cells(i - 1, 37) + 20
                      Else
                        .Left = 20
                     End If
                .Width = Cells(i, 32)
                .Height = Cells(i, 33) + 20
                .Caption = "No." & Cells(i, 17)
         End With
 End If

 If i = 1 Then
      pcname = "D:\キャスト\台帳１.gif"
      Image3.AutoSize = True
      Image3.Picture = LoadPicture(pcname)
      Image3.Move -Cells(i, 31), -Cells(i, 30) + 10

         With Frame3
                .Top = 20
                    If i > 1 Then
                      .Left = Cells(i - 1, 37) + 20
                      Else
                      .Left = 20
                    End If

                .Width = Cells(i, 32)
                .Height = Cells(i, 33) + 20
                .Caption = "No." & Cells(i, 17)
         End With
 End If

Next i

（ブンちゃん） 2015/01/06(火) 02:52

 >image(i)のようなことは不可能でしょうか

 Controlsコレクションを使うと近いことが可能です。

 例　UserForm内に　Image1　Image2　Image3　という三つのイメージコントロールがあるとすると、

 dim g0 as long
 dim pcname as string 
 pcname = "D:\キャスト\台帳１.gif"
 for g0=1 to 3
    with controls("Image" & g0)
       .AutoSize = True
       .Picture = LoadPicture(pcname)
    end with
 next

 こんな記述が可能です。試してみてください。

（ichinose） 2015/01/06(火) 04:53

有難う御座います、完璧です、甘えついでにもう一つ宜しいでしょうか、今度その表示された画像のどれかをクリックしたらuserfome１に商品説明を表示したいのですが、
Private Sub Image1_Click()
の書き方をお願いします。
（ブンちゃん） 2015/01/07(水) 03:37

 >userfome１に商品説明を表示したいのですが
 どこに表示させるのか？　にも依ります。
 例えば、画像のどれかをクリックしたら　Msgboxにて、商品説明を表示するなら

 表示させているイメージコントロールの数だけ商品説明をどこかに確保しておきます。
 例えば、配列などに

 dim mes( 1 to 10) as string 'イメージコントロールの数分宣言する

 イメージコントロールに画像を表示するタイミングで　上記のmesにも商品説明を　設定

 Private Sub Image1_Click() 
    msgbox mes(1)
 end sub
 Private Sub Image2_Click() 
    msgbox mes(2)
 end sub

 でよいと思います。

 この辺りのコードを纏めるには、　クラスモジュール　コントロール配列　等で過去ログを検索してください。

（ichinose） 2015/01/07(水) 07:03

今晩は、お世話になっています、クラスモジュールでコピーしてみたのですが、上手くいきません、お願いします。
クラスモジュールに
Option Explicit

 Public WithEvents img As MSForms.image
 Public id As Long '何番目のコントロールのペアかを示す数値
userformに
Option Explicit
 Private cls(1 To 10) As Class1
 Private Sub UserForm_Initialize()
    Dim g0 As Long
    For g0 = LBound(cls()) To UBound(cls())
       Set cls(g0) = New Class1
       With cls(g0)
          Set .img = Controls("image" & g0)

          .id = g0
          .img.Min = 1
          .img.Max = 10
          .img.Smallclick = 1
          .img.Value = 1
       End With
    Next
 End Sub
 '========================================================================
 Private Sub UserForm_Terminate()
    Dim g0 As Long
    For g0 = LBound(cls()) To UBound(cls())
       Set cls(g0) = Nothing
    Next
    Erase cls()
 End Sub
エラーが出ます、変更が間違っているようなのです、お願いします。
（ブンちゃん） 2015/01/10(土) 02:17

 >エラーが出ます
 どの箇所でどのようなエラーが発生しますか？

 この辺り、他人が見る（読む）ということを意識して投稿してください。
 これを意識することが　こういう掲示板でプログラミングの上達につながりますよ（必ず！！）。

        >.img.Min = 1
        >.img.Max = 10
        >.img.Smallclick = 1
        >.img.Value = 1

  イメージコントロールに上記のような　Minとか　Maxなんていうプロパティがありましたっけ？
  確認してみてください。

 >クラスモジュールに 
 >Option Explicit 
 >Public WithEvents img As MSForms.image
 >Public id As Long '何番目のコントロールのペアかを示す数値
 Private Sub img_Click()
    'ここにイメージコントロールがクリックされた時のコードを記述します。
 End Sub

（ichinose） 2015/01/10(土) 09:53

 疑似コントロール配列は、クラスモジュールとかオブジェクトに興味を持つきっかけにすぎません。
 ここから大変なので、

 最初の疑似コントロール配列のコード例を足し算だけの電卓というプログラムでコード化してみました。

 新規ブックにて。

 ユーザーフォームを作成してください（UserForm1）。

 UserForm1には、ラベルを一つ（Label1）と
 コマンドボタンを13個（CommandButton1　～　CommandButton13）を配置してください。
 ユーザーフォームの大きさや各コントロールの属性はコードで設定します。

 UserForm1のモジュールに

 '========================================================================================
 Option Explicit
 Private cls(1 To 10)   As Class1
 Private ans As Long
 Private Sub UserForm_Initialize()
　'ここでは、コントロ－ルの位置や大きさの初期設定やクラスモジュールへの登録
    Dim g0 As Long
    Dim cap(11 To 13) As String
    cap(11) = "C": cap(12) = "+": cap(13) = "="
    With Me
       .Width = 206.25
       .Height = 194.25
       .Caption = "たしざんだけの電卓"
    End With
    With Label1
       .Left = 12
       .Top = 10
       .Width = 168
       .Height = 20
       .SpecialEffect = fmSpecialEffectSunken
       .BackColor = vbWhite
       .Font.Size = 14
       .TextAlign = fmTextAlignRight
       .Caption = "0"
    End With
    For g0 = 1 To 9
       With Controls("CommandButton" & g0)
          .TakeFocusOnClick = False
          .TabStop = False
          .Font.Size = 14
          .Left = ((g0 - 1) Mod 3) * 30 + 12
          .Top = 96 - ((g0 - 1) \ 3) * 30
          .Width = 30
          .Height = 30
          .Caption = Val(Replace(UCase(.Name), UCase("CommandButton"), "")) Mod 10
       End With
    Next
    With CommandButton10
       .TakeFocusOnClick = False
       .TabStop = False
       .Font.Size = 14
       .Left = 12
       .Top = 126
       .Width = 60
       .Height = 30
       .Caption = "0"
    End With
    For g0 = 11 To 13
       With Controls("CommandButton" & g0)
          .TakeFocusOnClick = False
          .TabStop = False
          .Font.Size = 14
          .Left = 150
          .Top = (g0 - 11) * 30 + 36
          .Width = 30
          .Height = 30
          .Caption = cap(g0)
       End With
    Next
    For g0 = 1 To 10
       Set cls(g0) = New Class1
       With cls(g0)
          Set .cmd = Controls("CommandButton" & g0)
          Set .lbl = Label1
       End With
    Next
 End Sub
 Private Sub UserForm_Terminate()
    Dim g0 As Long
    For g0 = 1 To 10
       Set cls(g0) = Nothing
    Next
 End Sub
 Private Sub CommandButton11_Click()
    ans = 0
    Label1.Caption = "0"
 End Sub
 Private Sub CommandButton12_Click()
    ans = ans + Val(Label1.Caption)
    Label1.Caption = "0"
 End Sub
 Private Sub CommandButton13_Click()
    ans = ans + Val(Label1.Caption)
    Label1.Caption = ans
    ans = 0
 End Sub

 次にクラスモジュールを一つ作成してください(Class1）。

 Class1のモジュールに

 '===================================================================================== 
 Option Explicit
 Public WithEvents cmd As MSForms.CommandButton
 Public lbl As MSForms.Label
 Private Sub cmd_Click()
    Dim vl As String
    vl = cmd.Caption Mod 10
    If Val(lbl.Caption) <> 0 Or Val(vl) <> 0 Then

       lbl.Caption = Format(lbl.Caption, "#") & vl
    End If
 End Sub

 標準モジュールに

 '=================================================================
 Option Explicit
 Sub main()
    UserForm1.Show
 End Sub

 mainを実行して、たしざんだけの電卓を使ってみてください。
 尚、この電卓　＝ボタンクリックで答えが表示されます。

 これは、コントロール配列の完成形ではないのですが、
 コントロール配列のしくみやクラスモジュール理解の
 参考にしてください。

（ichinose） 2015/01/11(日) 10:36

貴重なプログラム例を有難う御座います、自作へ引用出来るところはどこか、取得出来るか頑張ってみます。
（ブンちゃん） 2015/01/16(金) 02:17

コメント返信：

[ 一覧(最新更新順) ]

[[20141125005151]] 『vba 画像のトリミング』（ブンちゃん） ページの最後に飛ぶ

[[20141125005151]]　『vba 画像のトリミング』（ブンちゃん）　ページの最後に飛ぶ