[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『画像を回転させる』（りあき）
現在写真帳を作っております。
画像を選択してボタンをクリックすると９０度ずつ回転し、なおかつセル枠にあわせて拡大縮小するようにするにはどうしたらよいでしょうか？
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
回転するだけでサイズは一致しませんか。
手作業で回転させてみましたか。
回転だけでよい場合でも、マクロ必要ですか。
手作業で回転ではだめなのですか。
（マナ） 2019/09/10(火) 18:46
（マナ） 2019/09/10(火) 18:53
＞回転するだけでサイズは一致しませんか。
＞手作業で回転させてみましたか。
（マナ） 2019/09/11(水) 20:27
まず、画像ファイルには回転情報を持つものがありますが、これを無視して画素の並び通り表示するアプリ等があります。なので、ビューワや画像編集ツールで一旦回転させてから元に戻すことで、回転情報が無くなって、どんなアプリでも思った通りの向きで表示されるようになります。これが一番確実。
次に、Excel上で回転情報を得て、自動的に回転するかどうか判断しようとする場合、GDI++を使えば可能だと思います。 使い方の面倒なAPIなので、これを実現しようとするならば、ご自分でGDI++の使い方を調べてみてください。（ささっと書いてあげるレベルじゃないです）
もうひとつ考えられるのが、人間がExcelに貼った画像を見てから、特定の画像をExcel上で回転させる方法。 この場合、マクロの記録でも簡単にコードが得られるのでご自分で見つけて欲しかったのですが、図形オブジェクトに対して .Rotationプロパティで角度を指定する事で、任意の角度に回転できます。 Excelのオブジェクトのプロパティを変えるだけなので、張り付けた画像内の回転情報は変わりませんが、問題はないと思います。 例えば、画像を貼る際に以下のコードをマクロ登録しておけば、画像をクリックする度に回転するようにできます。 これにリサイズ処理を加える程度が良いのではないでしょうか。
Sub 図1_Click()
With ActiveSheet.Shapes(Application.Caller)
.Rotation = (.Rotation + 90) Mod 360
End With
End Sub
（???） 2019/09/12(木) 09:15
なんか無駄くさい。 キリンが、キリンじゃなくなったり・・・？ 正方形で作り直すか、円の図形の中に入れた方が良いのでは？ 回転しても、高さ幅は同じ扱いでは？ （作り直した方が） 2019/09/12(木) 14:48
とりあえず、回転角度は無視して、縦横比は正しい画像が貼れているものとした、クリックすると回転する例なぞ。 回転させる度に回転情報なしでJPEG保存し直すことで、現在の元画像不明な状況を無視しています。（画像少し劣化しますが、仕方なし）
Sub 図1_Click()
Dim R As Range
Dim iw As Single
Dim ih As Single
With ActiveSheet.Shapes(Application.Caller)
Set R = .TopLeftCell
.Rotation = 90
.LockAspectRatio = msoTrue
.ScaleHeight 1!, msoTrue
.ScaleWidth 1!, msoTrue
.Cut
End With
ActiveSheet.PasteSpecial Format:="図 (JPEG)"
With Selection
.OnAction = "図1_Click"
.Width = R.Width
If R.Height < .Height Then
.Height = R.Height
End If
.Top = R.Top + (R.Height - .Height) / 2
.Left = R.Left + (R.Width - .Width) / 2
End With
End Sub
（???） 2019/09/12(木) 15:19
>回転しても、高さ幅は同じ扱いでは？
補足、 回転しても、図形の高さは高さ。幅は幅。という意味。 画像の高さをセルの高さに合わせてある場合、回転後画像の高さがセルの幅になるだけ。
（作り直した方が） 2019/09/12(木) 16:42
力ずくで書いてみました。
・選択している写真（複数選択も可）に対して、 ・右90度回転、または、左90度回転を実行する。 ・回転後は、その写真の置いてある左上端の1セルのWidth,Height内に収める。 ・セルの左上に合わせるか、中央寄せかは調節可能（コードを修正のこと）
ただし、Windows7,Excel2010でしか確認していないので、他のVersionは保証できない。 また、もともとの写真に回転情報が入っている場合とかの難しいことは考慮してません。
Sub test()
Dim pic As Picture
Dim msg, style, title, response
Dim direction As Long
'画像選択を指示
If Not (TypeName(Selection) = "Picture" Or TypeName(Selection) = "DrawingObjects") Then
MsgBox "画像を選択して下さい。複数同時指定できます"
Exit Sub
End If
'右回転、左回転の指定
msg = "右90度回転なら「はい」、左90度回転なら「いいえ」"
style = vbYesNoCancel
title = "回転指定"
response = MsgBox(msg, style, title)
Select Case response
Case vbYes: direction = 1 '右90度回転
Case vbNo: direction = -1 '左90度回転
Case vbCancel: Exit Sub 'キャンセル
End Select
' 回転の実行
If TypeName(Selection) = "Picture" Then
Call myRotation(Selection, direction)
Else
For Each pic In Selection
Call myRotation(pic, direction)
Next
End If
End Sub
Sub myRotation(pic As Picture, direction As Long)
Dim x0#, y0#, xc#, yc#
Dim ary As Variant
Dim rng As Range
Dim ratio#
Dim ratioAfterRotate#
Dim r#
Dim newRotation!
newRotation = direction * 90!
Set rng = pic.TopLeftCell
With pic
'(1)回転後の縦、横幅、Left,Top座標を算定する
ratio = .Height / .Width
ratioAfterRotate = 1 / ratio
r = rng.Height / rng.Width
If r <= ratioAfterRotate Then
.Width = rng.Height
.Height = rng.Height / ratioAfterRotate
'中央寄せなら↓の項を活かす
x0 = rng.Left '+ (rng.Width - .Height) / 2#
y0 = rng.Top
Else
.Height = rng.Width
.Width = rng.Width * ratioAfterRotate
x0 = rng.Left
'中央寄せなら↓の項を活かす
y0 = rng.Top '+ (rng.Height - .Height) / 2#
End If
'(2)回転後の位置が上記の位置となるよう、
' 回転前の位置(左上隅）を逆算し、そこに移動させる
xc = x0 + .Height / 2#
yc = y0 + .Width / 2#
ary = myRotate(x0, y0, xc, yc, (-1) * newRotation)
If direction = 1 Then
.Left = ary(0)
.Top = ary(1) - .Height
Else
.Left = ary(0) - .Width
.Top = ary(1)
End If
'(3)回転処理
.ShapeRange.Rotation = newRotation
End With
End Sub
'(xc,yc)を回転中心として、(x,y)をtheta度 回転した位置を返す。
Function myRotate(x As Double, y As Double, xc As Double, yc As Double, theta As Double) As Variant
Dim xx As Double
Dim yy As Double
theta = WorksheetFunction.Radians(theta) 'ラジアンに変換
xx = (x - xc) * Cos(theta) - (y - yc) * Sin(theta) + xc
yy = (x - xc) * Sin(theta) + (y - yc) * Cos(theta) + yc
'thetaは ±π/2だから、もっと簡単に書けるわけだが、一応。
myRotate = Array(xx, yy)
End Function
（γ） 2019/09/13(金) 07:29
（γ） 2019/09/14(土) 09:56
現在使用している画像貼り付けのコードで、
貼り付ける前に、回転させるかどうか確認メッセージを出す。
γさんのコードのように、Msgboxを使うと良いです。
回転させるなら「はい」、させないなら「いいえ」とかです。
で、「はい」なら、Target,WidthとTarget,Heightを逆に扱う。
というコードに修正してはどうでしょうか。
現在のコードが理解できていれば、難しくはないはず。
理解できてなくても、試行錯誤で何とかなると思います。
貼り付けてみてセルからはみ出したななら、
手作業で画像を削除して、条件逆にしてマクロ実行。
2010以前でも使用することがあるなら、
回転機能が欲しくなるかもしれません。
その場合は、???さんの
＞ 例えば、画像を貼る際に以下のコードをマクロ登録しておけば、
＞画像をクリックする度に回転するようにできます。
を使うとよいでしょう。
（マナ） 2019/09/14(土) 14:03
横から失礼します。
二つのキーワードの参考コードです。
If ActiveCell.MergeCells = True Then MsgBox ActiveCell.MergeArea.Address （カリーニン） 2019/09/18(水) 17:59
Set R = .TopLeftCell.MergeArea
（???） 2019/09/18(水) 18:19
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.