|
▼ichinose さん:
.Adjustments(1)はよく知らなかったのですが、吹出しでは先っぽの位置などの
数値をボックスとの比例で指定するものなんですね。
ichinoseさんのマクロから、
作成したときだけでなく、いつでも自動サイズ調整に対応するため、以下のようなことを考えてみました。
1)生成するとき
先っぽの位置を、吹出し自身に記憶していてもらう。
2)ボックス内を編集したときに(当然自動サイズ調整で先の位置が変わってしまう)
記憶しておいた先の位置情報を取り出してその位置に先の場所を修正する。
そして吹出しがセレクトされたときに2)をするようにすればうまくいくかと思っているのですが...(^_^;
とりあえず1)の方はichinoseさんのマクロから、以下微調整を(^_^;
Sub ふきだし()
Dim vLeft, vtop, vHeight, vWidth As Long
Dim svx As Double, svy As Double
With ActiveCell '位置調整
vLeft = .Left + .Width + 22
vtop = .Top - 15
vHeight = 10
vWidth = 50
End With
With ActiveSheet.Shapes.AddShape(msoShapeLineCallout3, vLeft, vtop, vWidth, vHeight)
svx = Round((.Adjustments(1) * vWidth + vLeft) / 0.75, 0) * 0.75
svy = Round((.Adjustments(2) * vHeight + vtop) / 0.75, 0) * 0.75
' svx = Round((.Adjustments(1) * .Width + .Left) / 0.75, 0) * 0.75
'svy = Round((.Adjustments(2) * .Height + .Top) / 0.75, 0) * 0.75
.AlternativeText = svx & ":" & svy
'.Adjustments1はこのフキダシの場合6種類
'.Item(1)ボックス位置そのままで先がx方向に移動
'.Item(2)ボックス位置そのままで先がY方向に移動
'.Item(3)ボックス位置そのままで引き出し線の折れるポイントがx方向に移動(-1から+1)
'.Item(4)不明 数値変えても変わらないように見える
'.Item(5)先位置そのままでボックスがX方向に移動(折れるポイント不動)
'.Item(6)先位置そのままでボックスがY方向に移動(折れるポイント不動)
.Fill.ForeColor.RGB = RGB(255, 204, 204)
With .Line
.ForeColor.SchemeColor = 20
.BeginArrowheadStyle = msoArrowheadOval
.EndArrowheadStyle = msoArrowheadOval
End With
With .TextFrame
With .Characters
.Text = ""
With .Font
.Name = "MS Pゴシック"
.Size = 8
End With
.Text = "@"
End With
.AutoSize = True
End With
.Adjustments(1) = (svx - .Left) / .Width
.Adjustments(2) = (svy - .Top) / .Height
.Select
SendKeys "> {BS}"
End With
End Sub
.AlternativeText を使って、覚えさせるというやり方です。
(他に吹き出しが持ってる、ユーザーが勝手にできそうな所を知らないので(^_^;)
問題は、2)の部分で、
まずどうやったら吹出しに書き終わったことを伝えられるのかがよくわかっていないところです。
アドバイスいただけるとありがたいです。
|
|