
Excelのワークシート上に画像(pic1)と四角の図形(waku)があります。
pic1にwakuを重ね、トリミングする場所を視覚的に確認したあと、VBAを実行し、wakuと同じ位置・サイズでpic1をトリミングするということを考えています。
とりあえず、実験的に左側をトリミングするマクロを作ってみましたがうまくいきません。
やってみた手順としては・・・
1.wakuの左端位置を取得
2.pic1の左端位置を取得
3.その差分を取得
4.差分と同サイズ、pic1の左側をトリミングする
・・・です。
Sub 左端をトリミング()
'枠の位置を取得
Dim wLeft As Single
wLeft = ActiveSheet.Shapes("waku").Left
'写真の位置を取得
Dim pLeft As Single
pLeft = ActiveSheet.Shapes("pct1").Left
'左側の差分を取得
Dim lTrim As Single
lTrim = wLeft - pLeft
ActiveSheet.Shapes("pct1").Select
Selection.ShapeRange.PictureFormat.CropLeft = lTrim
End Sub
結果としては想定しているものの2倍分くらい、トリミングされてしまいます。
最後の一文が、よくわからないまま、ネットから拾ってきた感じで使用しており、そこに問題があるのかと思うのですが・・・
どのようにするのが正しいのか、教えていただければ幸いです。
最終的には同様に上端を、右端・下端についてはそれぞれの図形のサイズの差からトリミングすべきポイントを抽出して希望のサイズにトリミングするつもりでいます。
ちなみに趣旨は・・・
・PCの知識の少ない人でも出来るようにしたい。
・wakuをリサイズさせないことで、縦横比・画像サイズを固定したい。
・・・というものです。
「VBAなんか使わなくても、こうすれば簡単じゃん!」みたいな方法があればあわせて教えていただ得れば幸いです。
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
ぁ..Sub try は Doの前に以下3行追加したほうがベターでしたね..orz
sp.Width = 120 '固定したいWidth
sp.Height = 90 '固定したいHeight
sp.ZOrder msoBringToFront '最前面
No.4
- 回答日時:
とりあえず倍率が問題なら
Sub test()
Dim p As Picture
Dim s As Shape
Dim w As Single
Dim h As Single
Dim x As Double
Dim y As Double
Set p = ActiveSheet.Pictures("pct1")
Set s = ActiveSheet.Shapes("waku")
'wakuサイズ固定したいなら姑息ですが結果オーライな?
's.Width = 400
's.Height = 300
'以下pの倍率取得
w = p.Width
h = p.Height
p.ShapeRange.ScaleWidth 1, msoTrue
p.ShapeRange.ScaleHeight 1, msoTrue
x = p.Width / w
y = p.Height / h
'倍率取得したら戻す
p.Width = w
p.Height = h
'トリム処理。マイナス値は考慮してない。
With p.ShapeRange.PictureFormat
.CropLeft = (s.Left - p.Left) * x
.CropTop = (s.Top - p.Top) * y
.CropRight = (p.Width - s.Width) * x
.CropBottom = (p.Height - s.Height) * y
End With
s.Left = 0
s.Top = 0
End Sub
こんな感じで。
以下参考。
四角Shapeにマクロtryを登録し、画像を選択してShapeをクリックすると
マウスカーソルに合わせてShapeが移動します。
トリミング位置に合わせてもう一度Shapeをクリック。
'標準モジュール
Option Explicit
Private Declare Function GetCursorPos Lib "user32" ( _
ByRef lpPoint As POINTAPI) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
Private Type POINTAPI
x As Long
y As Long
End Type
Private MoP As POINTAPI
Private flg As Boolean
'-------------------------------------------------
'Shapeは透過、最前面配置にしておく。
'このtryをShapeに登録する。
'Pictureを選択してShapeクリックで実行。
'~~~~~~~~~~~~~~~~~
Sub try()
Const DPI As Long = 96 'Dot per inch 取り敢えず固定
Const PPI As Long = 72 'Point per inch
Dim pc As Picture
Dim sp As Shape
Dim w As Single
Dim h As Single
Dim x As Double
Dim y As Double
If flg Or (TypeName(Selection) <> "Picture") Then
flg = False
Exit Sub
End If
On Error GoTo ErrHandler
flg = True
Set pc = Selection
With pc.ShapeRange
.Rotation = 0
With .PictureFormat
.CropLeft = 0
.CropTop = 0
.CropRight = 0
.CropBottom = 0
End With
End With
With Application
.ScreenUpdating = False
'WindowZoom100、分割なし限定。
With .ActiveWindow
.Zoom = 100
.SplitColumn = 0
.SplitRow = 0
End With
.ScreenUpdating = True
.StatusBar = ""
.Cursor = xlNorthwestArrow
Set sp = ActiveSheet.Shapes(.Caller)
End With
Do
DoEvents
Call Sleep(1)
If Not flg Then Exit Do
Call GetCursorPos(MoP)
With ActiveWindow
sp.Left = (MoP.x - .PointsToScreenPixelsX(0)) * PPI / DPI - (sp.Width / 2)
sp.Top = (MoP.y - .PointsToScreenPixelsY(0)) * PPI / DPI - (sp.Height / 2)
End With
Loop
Application.ScreenUpdating = False
With ActiveSheet
If Not Intersect(.Range(pc.TopLeftCell, pc.BottomRightCell), _
.Range(sp.TopLeftCell, sp.BottomRightCell)) Is Nothing Then
w = pc.Width
h = pc.Height
pc.ShapeRange.ScaleWidth 1, msoTrue
pc.ShapeRange.ScaleHeight 1, msoTrue
x = pc.Width / w
y = pc.Height / h
pc.Width = w
pc.Height = h
With pc.ShapeRange.PictureFormat
.CropLeft = Application.Max(0, (sp.Left - pc.Left) * x)
.CropTop = Application.Max(0, (sp.Top - pc.Top) * y)
.CropRight = Application.Max(0, (pc.Width - sp.Width) * x)
.CropBottom = Application.Max(0, (pc.Height - sp.Height) * y)
End With
End If
End With
sp.Left = 0
sp.Top = 0
ErrHandler:
With Application
.Cursor = xlDefault
.StatusBar = False
.ScreenUpdating = True
End With
Set pc = Nothing
Set sp = Nothing
End Sub
うまくいかない時は捨ててください。
No.3
- 回答日時:
・ wakuをリサイズさせない
たぶんムリ。移動を許すとリサイズもできます。
イベントか何かで(頻繁に)サイズ修復・・・するしか。wakuは図形じゃなく画像にすると、"透過部分を掴める"ので、扱いやすく、縁触らないのでリサイズもされにくいかな、と。
・縦横比・画像サイズを固定
ANo.2の通り、トリミングは拡縮に弱いです。初心者相手は壊されやすいのもあり、しっかりロックして操作制限するならトリミングが一番簡単ですが、うまくいかないよーなら後述の方法で。
・トリミング以外の方法
復元できないけど、「カット」でよければ別の手段も。
1. セル範囲をコピーして
2. (Excel2003なら) Shift押しながらメニューの[編集]
(Excel2007~) ホームタブの[貼り付け]
→ 図として貼り付け
この操作でセル上の画像を切り出せます。
実装は、非表示の作業シートを用意しておきます。まず切り抜くセルがwakuと同じ位置&サイズになるよう調整し、その上に画像を。あとはセルをCopy -> PasteSpecialで画像化。
面倒だけど、拡大縮小や合成などに対応でき、画像処理には向きます。また、カットするのでファイルサイズは小さくなります。
・余談ですが
画像編集なら、Chart.ExportでGIF/PGN出力も簡単にできるので、調べてみるのもよいかと。
目的によるけど。
No.2
- 回答日時:
画像にサイズ(倍率)が指定されてると狂いますよ。
・Cropは「元の画像をトリム」、その後に倍率適用。
・Crop値も最終画像サイズも1ドット(=0.75pt)単位。
200%の画像だと、CropXX = 0.75 で 1.5ptトリミングされ、コレが最小単位になるってのが致命的。また、最終画像サイズの端数丸めでも歪むので、調整しようにも何かとメンドクサイです。
復旧不能でもよければ、「セルを画像としてコピー」で切り出しては?
ちょっと後で補足しに来ます・・・
★とりあえず、調べ方
MSDN@MicroSoftの開発者向けサイト。細かいパラメータの説明欲しいときは「MSND VBA Crop」とかでググる。
http://msdn.microsoft.com/ja-jp/library/microsof …
また、VBE(エディタ)は便利な機能多いので、「ローカルウィンドウ」で変数やオブジェクトの中覗くとか勉強になるかと。
Set obj = ActiveSheet.Shapes("pct1")
w = obj.Width '←↑変数の中覗く
No.1
- 回答日時:
ワークシートに貼り付けた集合写真上に顔の部分に合わせて複数の四角を並べ、一斉にトリミングというコードを回答した事があります。
ご参考まで。http://oshiete.goo.ne.jp/qa/6236568.html
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) 【マクロ】スクショ印刷がうまく動かない件 5 2022/12/06 17:37
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Visual Basic(VBA) EXCEL VBAにて動的にCheckBOXを複数作成し、同BOXにイベントを追加したい 1 2023/03/16 07:05
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Excel(エクセル) エクセルで同じ数字同士を自動で線で結ぶVBAを教えてください 6 2022/04/26 23:13
- Visual Basic(VBA) Excel VBA キーワードから列を取得して、さらに空欄行を非表示にする 3 2022/10/21 22:49
- Visual Basic(VBA) 【VBA】写真の縦横比を変えずに貼り付ける 5 2023/06/13 11:42
- Visual Basic(VBA) サブフォルダ(データ)にある複数の.xlsxファイルのSheet3のA2セルの値で01から左側をB2 2 2022/08/14 15:46
- HTML・CSS トリミングで表示した画像をクリックで元どおりにしたい 3 2022/12/16 18:49
このQ&Aを見た人はこんなQ&Aも見ています
-
初めて見た映画を教えてください!
初めて見た映画を覚えていますか?
-
「これはヤバかったな」という遅刻エピソード
寝坊だったり、不測の事態だったり、いずれにしても遅刻の思い出はいつ思い出しても冷や汗をかいてしまいますよね。
-
最強の防寒、あったか術を教えてください!
とっても寒がりなのですが、冬に皆さんがされている最強の防寒、あったか術が知りたいです!
-
AIツールの活用方法を教えて
みなさんは普段どのような場面でAIツール(ChatGPTなど)を活用していますか?
-
14歳の自分に衝撃の事実を告げてください
タイムマシンで14歳の自分のところに現れた未来のあなた。 衝撃的な事実を告げて自分に驚かせるとしたら何を告げますか?
-
【VBA】写真の縦横比を変えずに貼り付ける
Visual Basic(VBA)
-
マクロを実行すると画像がズレてしまいます
その他(Microsoft Office)
-
ExcelVBA トリミング範囲の指定で
Word(ワード)
-
-
4
エクセルvbaでの図形のカット(コピー)ペーストについて
Excel(エクセル)
-
5
パワーポイントでトリミングを繰り返し行うマクロ
PowerPoint(パワーポイント)
-
6
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
7
エクセルVBAでセル番地を指定してオブジェクト名取得
Excel(エクセル)
-
8
VBA Shapes コピーと名前
Excel(エクセル)
-
9
エクセルVBA 画像を貼り付けるセル位置を指定する方法
Excel(エクセル)
-
10
Excel ユーザーフォームで表示させた画像をユーザーフォーム上で保存したい
Visual Basic(VBA)
-
11
エクセルVBAで縦向きの画像の挿入・回転
Excel(エクセル)
-
12
EXCEL ページを指定してPDF出力するVBAを教えてください。
PDF
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
pdfをvbaで開いて、さらにサ...
-
excelの列幅高さが勝手に変わる...
-
ワードA3で作成したファイルをA...
-
邪魔なwww.softonic.jpの消し方...
-
Excel 列幅のピクセル数につい...
-
WordのA3で作成されたファイル...
-
ワード B4→A4に縮小印刷す...
-
エクセルに添付された画像が×に...
-
アンドロイドタブレットを使っ...
-
卒業証書をコンビニでA4コピー...
-
Excelで連続するデータの個数を...
-
フォトショップで画像を貼り付...
-
Windowsで大量の画像サイズを半...
-
フォトショップで切って分ける...
-
歪みと歪みはどう違う?
-
JPEG24bitの画像に変換する方法
-
図の濃淡を調節するには。
-
C100M100 に近いDICカラーは...
-
JPEGの画像を重くしたい
-
画像の印刷ウィザード経由でCub...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCEL VBAで画像をトリミング
-
pdfをvbaで開いて、さらにサ...
-
グラフのトリミング
-
Wordに貼り付けた画像のサイズ...
-
excelの列幅高さが勝手に変わる...
-
ワードA3で作成したファイルをA...
-
邪魔なwww.softonic.jpの消し方...
-
WordのA3で作成されたファイル...
-
ワード B4→A4に縮小印刷す...
-
フォトショップで画像を貼り付...
-
JPEGの画像を重くしたい
-
Excelで連続するデータの個数を...
-
Excel 列幅のピクセル数につい...
-
アンドロイドタブレットを使っ...
-
歪みと歪みはどう違う?
-
卒業証書をコンビニでA4コピー...
-
このハードディスクは危ないで...
-
フォトショップで切って分ける...
-
エクセルに添付された画像が×に...
-
Windowsで大量の画像サイズを半...
おすすめ情報