エクセルのコメントで自動サイズ調整

質問

Excel2000です。
ワークシート、 Sheets("Comment")上のデータにもとづき、自動でセルにコメントを挿入するマクロを書きました。
以下で、正常に作動します。
問題は、TextFrameの自動サイズ調整の部分です。
このままだと、文字列の長さに応じて横にだけ長くなってしまうのです。
かといって、文字列の長さはバラバラなのでサイズを固定するわけにもいきません。
コメントの横幅は一定で、縦の長さだけ文字数に応じて自動で変わるような設定はできないものでしょうか？
Sheets("Comment")上のデータをAlt+Enterでセル内改行させることにより対応はできますが、もっといい方法がないか質問させていただきました。
Lenで文字数を調べ、これに応じて対応させるのは、全角半角が入り混じったデータなので無理そうです。
宜しくお願い申し上げます。

Sub Comment挿入()
Dim sa As String, ad As String, tx As String
With Sheets("Comment")
For i = 2 To 42
sn = .Cells(i, "A").Value 'シート名
ad = .Cells(i, "B").Value 'セルアドレス
tx = .Cells(i, "C").Value 'テキスト
With Sheets(sn).Range(ad)
.AddComment
With .Comment
.Visible = False
.Text Text:=tx
.Shape.Shadow.Visible = msoFalse '影無し
.Shape.Fill.ForeColor.SchemeColor = 42 '背景を水色
.Shape.Line.ForeColor.SchemeColor = 10 '枠線を赤
.Shape.TextFrame.Characters.Font.Name = "MS UI Gothic" 'フォント指定
.Shape.TextFrame.Characters.Font.ColorIndex = 3 'フォント色を赤
.Shape.TextFrame.AutoSize = True '自動サイズ調整
End With
End With
Next i
End With
End Sub

回答No.2

end-u · ベストアンサー

私も思いつきで。（アイデアのみですが）
セルにコメント用テキストが入力してあるなら、
セル幅を固定したいコメント幅にしておいて、セルの行高自動調整を使ってみてはどうでしょう。

セルの設定を.WrapText = True にして
.Rows.AutoFitメソッドを使って自動設定される .Height にコメントの .Height を合わせるわけです。
（Font種別やサイズなどを合わせる必要がありますし、セルのHeightの最大値が409.5なので文字数が多い場合は困りますけど）
必要ならセル側の設定を戻す処理を行ったり、作業用のダミーシートを使ったりすると良いかもしれません。

お礼

ありがとうございます。これはGood Ideaだと思い試してみました。
セル内で折り返して表示させ、行高を自動設定させて
hg = .Cells(i, "C").Height 'セル高
wd = .Cells(i, "C").Width 'セル幅　として取得した数値でコメントのサイズを設定させました。
残念ながら、エクセルのワークシートのセル内文字の見かけ上の配置と実際にプリントしたときの配置が違うせいなのか、サイズが不足してしまいます。

補足

すみません、お礼でサイズが小さいと書きましたが、わたしのコードの誤りでした。
修正したらうまくいきました。
大変失礼いたしました。
ありがとうございます。

回答No.3

hige_082

Sub Comment挿入()
Dim sa, sn, ad, tx As String

Dim 開始位置, 壱行文字数, 文字数 As Integer
Dim 作業文字列 As String
壱行文字数 = 15　　　　　　　　　　'ここで１行の文字数を設定

With Sheets("Comment")
For i = 2 To 42
sn = .Cells(i, "A").Value 'シート名
ad = .Cells(i, "B").Value 'セルアドレス
tx = .Cells(i, "C").Value 'テキスト

作業文字列 = StrConv(tx, vbWide)
文字数 = Len(作業文字列)
For 開始位置 = 1 To 文字数 Step 壱行文字数
If 開始位置 = 1 Then
tx = Mid(作業文字列, 開始位置, 壱行文字数)
Else
tx = tx & vbLf & Mid(作業文字列, 開始位置, 壱行文字数)
End If
Next 開始位置

With Sheets(sn).Range(ad)
.AddComment
With .Comment
.Visible = False
.Text Text:=tx
.Shape.Shadow.Visible = msoFalse '影無し
.Shape.Fill.ForeColor.SchemeColor = 42 '背景を水色
.Shape.Line.ForeColor.SchemeColor = 10 '枠線を赤
.Shape.TextFrame.Characters.Font.Name = "ＭＳ ゴシック" 　　　　　'等倍フォントへ変更
.Shape.TextFrame.Characters.Font.ColorIndex = 3 'フォント色を赤
.Shape.TextFrame.AutoSize = True '自動サイズ調整
End With
End With
Next i
End With
End Sub

横幅を合わせるには
文字をすべて半角か全角に統一し、尚且つ等倍フォントを使用しなければ無理だと思います
文字数によっては半角のずれが生じるため

お礼

ありがとうございます。
これもうまくいきました。ただ、出来ることならコメントの全角半角混在の設定は変えたくないのです。
でもとても勉強になりました。

回答No.1

fujillin

思い付きのアイデアレベルなので、きちんとテストはしていませんが…

『一度autoで作成してから、同じ面積になるようにwidth固定で幅、高さを再設定する』というのではいかがでしょうか？
（実際には、繰上げ計算しているので、安全側の大きめになるはずです）
簡単な試行をして見た限りでは、まぁ、許容範囲かと…

＜widthを100に固定した場合の例＞
　.Shape.TextFrame.AutoSize = True '自動サイズ調整
の後に以下の2行を追加。
　.Shape.Height = Fix(.Shape.Width / 100 + 1) * .Shape.Height
　.Shape.Width = 100

元の文章には改行がないと仮定していますが、文章が長くなってくると↑の安全側の評価が累積して余白が大きくなってきますね。
（単純にHeightの倍数を取るとmarginの分を余分に拡大しているかも）
例えば、少し改善するにはHeightの設定を
　.Shape.Height = Fix(.Shape.Width / 100 + 1) * (.Shape.Height - .Shape.TextFrame.MarginTop) + .Shape.TextFrame.MarginTop
としてやるとか…
（MarginBottomも同様に扱うと、今度は行数が少ない時に高さ不足して、文字が入りきらなくなってしまうみたい）

幅と高さの計算式は、まだ改善の余地がありそうですが、とりあえずは、ひとつのアイデアの提供ということで…

お礼

ありがとうございます。
等幅フォントに変更し
　.Shape.Height = Fix(.Shape.Width / 100 + 1) * .Shape.Height
　.Shape.Width = 100
でうまくいきました。たしかに文章が長くなってくると余白が大きくなってきますが実用上問題はないです。
助かりました。