[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『vba 画像のトリミング』(ブンちゃん)
今晩は初めまして悩んでいます助けて下さい、200枚ぐらいの
A4に20個ほどの小さい消しゴムほどの商品の写真がありその一つ一つの検索ファイルを
作っています、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 >
ところで、アップされたコード、いくつか疑問があるなぁ。
・サイズ変更まで出来ましたが
ほんと?
・With Image1/End With
これは、なにをしているつもり?
・以下は何をしているつもり?
.Left = 20 .Top = 50 .Width = 50 .Height = 100
目的とコードがあっていない気がしてコメントもしづらいけどImageコントロールの
PictureAlignmentプロパティを調べるとImage内での画像のセット位置について
ヒントがあるかも。
http://www.excel-vba.net/excel-userform-005.html
16:57 追記
PictureSizeModeプロパティ なんかも、今回のテーマには便利かも。
(通りすがり) 2014/11/25(火) 11:49
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
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に見えているのは画像の
左上から右に50ピクセル下に100ピクセルです、この50×100のimageを画像の例えば左から200ピクセル、上から200ピクセルに移動して、
一つの商品を表示をしたいのですが無理でしょうか
どうかお願いします。
(ブンちゃん) 2014/11/25(火) 21:01
Imageコントロールだけでは、難しいので・・・・。
1 画像の加工をシート上で行う 対象画像をシート上に表示させ、画像のトリミングと位置決定を行い、表示画像を決定する
2 シート上の画像をユーザーフォームのImageコントロールに表示させる 簡単なのは、Chartから、一度、画像をJPGに保存して、再度、ユーザーフォームのImageコントロール にLoadPictureを使って表示させる
難しいけど、APIを使ってクリップボード周りでユーザーフォームのImageコントロール に表示させる
2は、例題があると思います。
1をマクロの記録などを使って、完成させt見てください
(ichinose) 2014/11/26(水) 06:54
・フォームにFrameコントロールを貼ります。
・Frame内にImageコントロールを貼ります。(Image1を切り取り、Frame選択状態で貼り付けてもOK)
・AutoSizeプロパティはTrue。
・Frame位置を移動すると、Imageも追従することを確認。
・FrameのCaptionプロパティの文字を消します。
・マクロでは、Image1.Move -200, -200 のように、トリミング開始位置分引いて指定。
(???) 2014/11/26(水) 10:26
↑ここで 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:\キャスト3" & 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
(通りすがり) 2014/12/31(水) 12:05
>1個では綺麗に出来るのですが、複数になると前の画像が残るのです、 >つまり1枚の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
Dim pcname
With UserForm6 .Top = 150 .Left = 200 End With
For i = 1 To Cells(1, 14)
If i = 1 Then pcname = "D:\キャスト\台帳1.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:\キャスト\台帳1.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:\キャスト\台帳1.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:\キャスト\台帳1.gif" for g0=1 to 3 with controls("Image" & g0) .AutoSize = True .Picture = LoadPicture(pcname) end with next
こんな記述が可能です。試してみてください。
(ichinose) 2015/01/06(火) 04:53
>userfome1に商品説明を表示したいのですが どこに表示させるのか? にも依ります。 例えば、画像のどれかをクリックしたら 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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.