写真や図形をセルの中心に並べたい
Excelは表形式のデータを柔軟に編集できるため、簡単なレイアウトツールやワープロ替わりに使うことができます(是非はさておき)。表形式に図形を並べる場合、セルの枠線を表の線として利用すると思うのですが、図形と枠線の間に適当な余白を設ける場合、図形をセルの中心に持ってきたくなりますが、いちいち手作業で修正するのは大変です。
そこで、図形を選択して実行するだけで、図形の中心をセルの中心に合わせるマクロを作成しました。
使い方
- 位置を調整する図形を選びます。
図形は1つでも複数でも構いません。 - マクロcenterObjectToCellを実行します。
選択された図形は、その図形の中心とセルの中心の距離が最小となるセルの中央に移動します。
コード
ユーザー定義関数centerCellを使用して求めたセルの位置に図形の位置を合わせています。found, known and done / Excelのオブジェクトの中心にあるセルを求める
foundknownanddone.blogspot.jp/2014/04/excel.html
Sub centerObjectToCell() Select Case TypeName(Selection) Case "DrawingObjects" For Each targetObject In Selection Call subroutineCenterObjectToCell(targetObject) Next Case "Range", "Nothing" MsgBox Prompt:="Select shapes or charts on worksheet.", Title:="centerObjectToCell" Case Else Call subroutineCenterObjectToCell(Selection) End Select End Sub Sub subroutineCenterObjectToCell(ByRef targetObject As Variant) With centerCell(targetObject) targetObject.Top = .Top + .Height / 2 - targetObject.Height / 2 targetObject.Left = .Left + .Width / 2 - targetObject.Width / 2 End With End Sub Function centerCell(ByRef targetObject As Variant) As Range Dim targetRange As Range Dim minIndex As Integer, minDistance As Double Dim originY As Double, originX As Double, targetY As Double, targetX As Double With targetObject Set targetRange = Range(.TopLeftCell, .BottomRightCell) originY = .Top + .Height / 2 originX = .Left + .Width / 2 End With With targetRange minDistance = Sqr(.Height ^ 2 + .Width ^ 2) For i = 1 To .Cells.Count targetY = .Cells(i).Top + .Cells(i).Height / 2 targetX = .Cells(i).Left + .Cells(i).Width / 2 distance = Sqr((targetY - originY) ^ 2 + (targetX - originX) ^ 2) If distance < minDistance Then minIndex = i minDistance = distance End If Next Set centerCell = .Cells(minIndex) End With End Function
No comments :
Post a Comment