Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 11 Pro : Microsoft 365)
80文字以上は折り返して、セルの高さ調整
投稿日時: 26/01/20 11:52:46
投稿者: segimasa175

結合しているセルの文字を80文字以上は折り返して、セルの高さを倍に指定

回答
投稿日時: 26/01/22 11:23:39
投稿者: Suzu

ご自身では、どこまで検討されて、
どんな事でつまづいていらっしゃるのでしょうか?
 
結合セルと言っていますが、
 どの方向に結合していて、
 その全ての行高さを高くするの? 1行目だけ?
 
サンプルコードを提示します。あとはご自身で調整ください。
 

Sub Sample()
'選択セルのテキストを80文字毎改行挿入

  '改行を入れる文字数
  Const stepNum As Long = 10

  Dim sourceText As String
  Dim restText As String
  Dim rowHight As Long
  Dim i As Long

  'アクティブなオブジェクトがセルか確認
  If TypeName(Selection) = "Range" Then
    '選択セルの1つ目のセル 計算式が設定されていない事を確認
      '計算式の場合、計算結果として文字が表示されているので
      '計算式の改変が必要
    If Selection.Cells(1).HasFormula = False Then

      'セルの値を取得
      sourceText = Selection.Cells(1).Text

      'セルの値 を stepNum 毎に処理
      For i = 1 To Len(sourceText) Step stepNum
        'stepNum 毎に、セルの値 i文字目から stepNum文字取得し
        '改行文字と連結
        restText = restText & Mid(sourceText, i, stepNum) & vbCrLf
      Next i
      '最後の改行文字を削除
      restText = Left(restText, Len(restText) - 1)

      With Selection.Cells(1)
        '高さ2倍
        .RowHeight = .RowHeight * 2
        'セルの値に代入
        .Value = restText
      End With
    End If
  End If
End Sub

回答
投稿日時: 26/01/26 14:36:16
投稿者: simple

人にものを尋ねるのと、生成AIに命令するのと二つを区別できない方のようですね。
回答者は機械じゃないです。人間に対して質問していることを忘れずに。
 
(1)
80文字以上は折り返して、とのことですが、それは半角換算でということですか?
もちろん、それは可能なのですが(手元にあります)、そのまま実現しても、問題点はあります。
行の最初の文字が、"、"や"。"で始まってしまうことがあります(禁則処理を自前でする必要)。
なおかつ表示や印刷で障害が起きる可能性もあります。
 
そもそも、そういうことをExcelで実現する場面が想像できません。
もしそうなら、それはWordなどで対応すべき話だと思います。
 
お薦めは、手動で列幅を調整することです。(自動で禁則処理がされます)
 
(2)
その上で、
「全体が表示されなくなったり、逆に余白が出来るので、それを行高で調整したい」
と言う話は過去にも結構登場しています。
しかし、単純計算で対応できる万能策は今まで出されていないと思います。
 
10数年前に議論したときのものを載せておきます。
(ある種の近似計算や微調整を施したものなので、読み取りにくいところはあると思いますし、
  場合によっては表示が欠けたり、印刷時に表示と異なるなどという事態になる可能性はあります。
  完璧なものは仕組みからして困難であることを承知して下さい。)
 
=== 以下参考コードです。=======

Rem 結合したセルには、「折り返して全体を表示」設定にして、
Rem お望みの列幅に修正しておいて下さい。
Rem 結合セルを選択した状態で、以下のマクロ実行してください。
Rem
Rem 列幅は現在とほぼ同じで、
Rem 結合セルに全体が表示されるように、各行の行高を調整します。

Sub 結合セルの行高調整()
    Dim currentCell As Range, mergeRange As Range
    Dim sum_of_ColumnWidth#, sum_of_Width#
    Dim sum_of_height#, backup_height#
    Dim backup_ColumnWidth#
    Dim y1#, y2#
    Dim c As Range
    Dim ratio#
    Dim targetHeight#

    Application.ScreenUpdating = False
    Set currentCell = ActiveCell

    If currentCell.MergeCells Then
        Set mergeRange = currentCell.MergeArea

        '結合領域のセル幅(ColumnWidthとWidth)の合計をそれぞれ算出
        sum_of_ColumnWidth = 0
        sum_of_Width = 0
        For Each c In mergeRange.Rows.Item(1).Cells
            sum_of_ColumnWidth = _
                    sum_of_ColumnWidth + c.EntireColumn.ColumnWidth
            sum_of_Width = sum_of_Width + c.EntireColumn.Width
        Next

        Rem===================================================
        Rem  結合セルの先頭セル(currentCell)を作業領域に使って、
        Rem  Autofitして、あるべき行高を求める。

        '結合領域の高さ(伸縮率計算用)
        sum_of_height = mergeRange.Height
        'アクティブセルの行高(復元用)
        backup_height = currentCell.Height

        With currentCell.EntireColumn
            'アクティブセルのセル幅(復元用)
            backup_ColumnWidth = .ColumnWidth
            
            'アクティブセルの列幅(columnWidth)を、「結合セルの列幅(columnWidth)の合計」と
            '同じ幅に設定 (線型近似による微調整を施しています)
            .ColumnWidth = sum_of_ColumnWidth
            y1 = .Width
            .ColumnWidth = sum_of_ColumnWidth + 2
            y2 = .Width
            .ColumnWidth = sum_of_ColumnWidth _
                    + 2 * (sum_of_Width - y1) / (y2 - y1) '設定すべき列幅
            
            
            '結合をはずし、アクティブセルに対してオートフィットをかける
            mergeRange.MergeCells = False
            currentCell.EntireRow.AutoFit
            targetHeight = currentCell.Height  '■これが求める高さ

            '復元(変更したのは、アクティブセルの行高、セル幅だけなので、それを元に戻す)
            .ColumnWidth = backup_ColumnWidth
            currentCell.EntireRow.RowHeight = backup_height
            mergeRange.Merge

        End With
        Rem =====================================================
        Rem 結合セル領域の各行の高さを、元の高さの比率で調整する。
        '行高の伸縮率
        ratio = (targetHeight + 3) / sum_of_height
        ' 3は遊び(若干詰まる感じなので)

        '各行の高さを伸縮させる
        For Each c In mergeRange.Columns.Item(1).Cells
            c.RowHeight = ratio * c.RowHeight
        Next
    Else
        currentCell.EntireRow.AutoFit    '普通にオートフィット
    End If

    Application.ScreenUpdating = True
End Sub

トピックに返信