0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

Microsoft Excelの最終列を画面いっぱい表示する

Posted at

Microsoft Excelの最終列を画面いっぱい表示する

Microsft Excelで表を作るとたまに、
「左の方の列は定型的なデータを表示する項目なので幅が決まるのだけれども、
一番右はその説明とかで、長い文章が入ったりするなあ」
という事があると思います。
「できればスクロールせずに全体が読めるようにしたいのだけれども」
というとき、その列を画面の一番右の端まで広げて表示し、
かつ、折返しもつけましょう、というルーチンです。
アクティブシートに対して作用します。

ratio - 罫線幅 * フリー列序数

最初の

Const 行幅 = "7.58,9.33,11.25,4.08,21,14,14"

は、各列に設定する幅を一番左の列からカンマ区切りで入れてってください。


   Columns(フリー列序数).ColumnWidth = (Application.Width - 合計Width + 補正値) / ratio - 罫線幅 * フリー列序数

の ” - 罫線幅 * フリー列序数” 部分は罫線とスクロールバーの占める幅を控除したつもりですが、ピッタリいきません。Microsoft Excelがアプリケーションとして占める幅は取得できたのですが、このへんの微調整のうまいやり方、知っている人がいれば教えて下さい。

Sub 最終列を目一杯広く表示する()

'A列から右へ、幅が決まっている列の列幅をCSVで指定
Const 行幅 = "7.58,9.33,11.25,4.08,21,14,14"
Dim arr_行幅 As Variant
    arr_行幅 = Split(行幅, ",")

'データを表示できない部分の画面幅
'実はよく分かってなくて適当です。(^^;
Const 補正値 = 20
Const 罫線幅 = 1

Dim フリー列序数 As Long
Dim ratio As Single
Dim 合計Width As Single

Dim n As Long, m As Long
Dim 控除数 As Long

    '目一杯広く表示したい列の序数は、Const行幅で指定した次の列
    フリー列序数 = UBound(arr_行幅) + 2

    '幅が決まっている列の専有する列幅を足してゆきます。
    合計Width = 0
    For n = 1 To UBound(arr_行幅) + 1
        Columns(n).ColumnWidth = arr_行幅(n - 1)
        合計Width = 合計Width + Columns(n).EntireColumn.Width
    Next n

    'ピクセルと文字数の換算レート
    'Microsoft Excelの画面幅はピクセルでしか出ないみたいなので
    'セル幅指定に普通用いる(単位のない)数字との割合をここで得る。
    ratio = Columns(1).Width / Columns(1).ColumnWidth

    'Microsoft Excel全体の画面幅から幅を定めたセル全体とデータを表示できない部分を減じて
    '最後のセルの幅に指定する。(マイナスになったら知らん。)
    Columns(フリー列序数).ColumnWidth = (Application.Width - 合計Width + 補正値) / ratio - 罫線幅 * フリー列序数

    '最後のセルの中身が全部表示できない場合は折り返して表示する。
    Range("1:" & Cells(Rows.Count, 1).End(xlUp).Row).WrapText = True
    Range("1:" & Cells(Rows.Count, 1).End(xlUp).Row).Rows.AutoFit

    'おまけで罫線引いてます。
    ActiveSheet.UsedRange.Borders.LineStyle = True
    ActiveSheet.UsedRange.Borders(xlInsideHorizontal).Weight = xlHairline

    '一番上の行は見出しと見て二重線で区切る。
    Range(Cells(1, 1), Cells(1, フリー列序数)).Borders(xlEdgeBottom).LineStyle = xlDouble

    '蛇足かも、1行目にフィルタ
    If ActiveSheet.AutoFilterMode = False Then
        Range("A1").AutoFilter
    End If

End Sub
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?