[[20110210212413]]　『VBA：縮小して表示されているセルの判定』（ご近所PG）　ページの最後に飛ぶ

『VBA：縮小して表示されているセルの判定』（ご近所PG）

 久しぶりに質問です。

 バージョン
Windows Vista,Excel2003

 ○背景説明（すっ飛ばし可）
現在、とあるシステムから出力されたCSVファイルをVBAにて取り込み、
整形済みのExcelシートへ値を流し込む仕組みを作っています。
　
この時、例えば「備考」セルがあり、そこにとても長い文字列が入ってくる事があります。
テンプレート上では「備考」セルを『縮小して全体を表示する』チェックを入れているのですが、
縮小された状態で印刷をかけた場合に、米粒のように小さくなってしまう事もあって、ちょと困ってしまいます。
　
縮小されてしまうのは縮小された、として構わないのですが、
一度それらが印刷に耐えうるサイズなのかを目視で確認する必要があります。
その「耐えうるサイズか」を判定をしていただくのがクライアント様なので、
「どこそこをチェックしてくださいね」とお願いする必要があります。

 ○本題
「縮小して全体を表示する」のセル文字が、実際に縮小されたかどうかを検出する方法は何かあるでしょうか。
等幅フォントなら文字数による判定だけで行けると思いますが、面倒な事に文字数を稼ぎたいという理由から
どうしてもプロポーショナルフォントを使わなければいけません。
あと、主題とは絡まないかもですが、セルは結合されてます。
　
いくつか自分なりに思っているのが
・縮小しない状態で、セルの範囲を文字列が飛び出しちゃうかどうか判定する方法があったような？
　→これを利用して、縮小して全体を表示するを解除して、飛出し判定して、またチェックを入れる？
　　でもどんな書き方か忘れてしまいました。
　　そして縮小の判定とイコールとなるかも不明。
・WindowsAPIで文字長を取得するようなもの
　→があったと頭の片隅にはあるのですがちょとテンパってて見つけきれません。
　　それがあれば長さ判定してセル幅を超えるかチェックできるかも？
　　けど、それがExcelに適用可能か不明な状態です。
・そもそも縮小後のフォントサイズを得られないか？
　→縮小された状態でセルのFontサイズを見たけど、変わってなかった。
　　他に何か実際に画面に出ているフォントサイズ等が格納されてる所でもあれば……
　
何か妙案をお持ちの方がいらっしゃいましたら、お教えいただけないでしょうか。
自分が難しく考えすぎで、プロパティ一発で、とかあったら泣き笑いしながら感謝します。

 簡単に思いつくのは・・・地味にチェックですね。
 使ってない場所にコピーして結合解除&ShrinktoFit解除、AutofitでWidthの比較

  Sub test()
  Dim tstRng As Range, r As Range

  Set tstRng = Range("IA1")
  For Each r In Selection
    If r.ShrinkToFit = True Then
      r.MergeArea.Copy tstRng
      With tstRng
        .UnMerge
        .ShrinkToFit = False
        .EntireColumn.AutoFit
        If .Width > r.MergeArea.Width Then
          r.MergeArea.Interior.ColorIndex = 6
        End If
      End With
    End If
  Next r
  tstRng.Resize(, 22).EntireColumn.Delete
  End Sub

 （ｍｏｍｏ）

 超速の回答ありがとうございます。なんと頼もしい学校だろう。
なるほど、未使用の場所を利用して……まさしく妙案。
　
簡易にサンプル作って動かしてみました。
見事に判定されました。
これで目的は達成できそうです。
ありがとうございました。

 質問を書き込んでからも色々つらつらーと考えてて、
適当にLabel貼ってAutoSize=Trueを利用して幅比較～とか思いついたんですが、
Excel上でのセル幅とイコールなのかしら？とか悩んでるところです。
えぇ、まだ試してません。試せたら結果報告します。
（ご近所PG）

 ラベルで試して同じような事は出来ました。
が、ラベルを使う利点は「？」
シートのレイアウトに影響を与えることはないだろうくらい？
フォントの状態とかを一緒にさせる手間があるのでめんどいかしら。
太字とか斜体とか、全部合わせないとかしら。
.font = .font でフォント情報ってそのまま入らないんですかね？
やってもダメだった。うーん。
　
一応、結果ってことで乗せときます。
今回は自分の環境に合わせてなんでフォントサイズとフォント名だけ合わせてます。
Sub test2()
    Dim r As Range
    Dim obj As OLEObject
    Set obj = Worksheets(1).OLEObjects.Add("Forms.Label.1")
    On Error GoTo ErrorHandler
    For Each r In Selection
        If r.Value <> "" Then
            'あらかじめ広げないと改行ありで調整されちゃう？のでチェック対象より広げる
            obj.Width = r.MergeArea.Width + 100
            With obj.Object
                'フォントとか揃える
                '.Font = .Font 'これだめ？
                .Font.Name = r.Font.Name
                .Font.Size = r.Font.Size
                '値を入れてオートサイズで調整させる
                .Caption = r.Value
                .AutoSize = False '一旦解除
                .AutoSize = True
            End With
            '幅比較でラベルの方が広かったら縮小されると判断
            If r.MergeArea.Width < obj.Width Then
                r.MergeArea.Interior.ColorIndex = 7
            Else
                r.MergeArea.Interior.ColorIndex = xlNone
            End If
        End If
    Next
ErrorHandler:
    '作ったラベルを削除
    obj.Delete
End Sub

 ちょと追加 2011/02/14 12:25
 >                .AutoSize = False '一旦解除
連続して同じ内容が続いた場合に自動調整されなかったので
（ご近所PG）

 ラベルでもフォントさえ同じにすればほぼ同じ結果になると思います。
 以前、セル内の文字列のある１文字の上に○を重ねることをする時に
 文字幅を出すのにラベルを使った事があります。

 テキストボックスとかだと余白の問題があるのでラベルが適してると思います。

 .Font=.Font　本当に使えると便利なんですけどね・・・

 なので簡易的に・・・という意味で別の場所で。を案としてみました。

 出来たようで良かったです。
 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110210212413]] 『VBA：縮小して表示されているセルの判定』（ご近所PG） ページの最後に飛ぶ

[[20110210212413]]　『VBA：縮小して表示されているセルの判定』（ご近所PG）　ページの最後に飛ぶ