列

幅

Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As LongDeclare PtrSafe Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As LongDeclare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Const LOGPIXELSX = 88 ' 横方向のDPI取得
Function SetColumnWidthTo108Pixels() As Double
    Dim hdc As Long, dpi As Double, pointWidth As Double    Dim col As Range    Dim pixelWidth As Double        ' 設定するピクセル幅    pixelWidth = 108
    ' 画面のDPIを取得    hdc = GetDC(0)    dpi = GetDeviceCaps(hdc, LOGPIXELSX)    ReleaseDC 0, hdc        ' ピクセルをポイントに変換（ポイント = ピクセル ÷ DPI × (8.08 / 0.75)）    pointWidth = (pixelWidth / dpi) * (8.08 / 0.75)        ' A列の幅を設定' Set col = ActiveSheet.Columns("A")' col.ColumnWidth = pointWidth        SetColumnWidthTo108Pixels = pointWidth        ' 結果を表示' MsgBox "A列の幅を " & pixelWidth & " ピクセル (" & Format(pointWidth, "0.00") & " ポイント) に設定しました。", vbInformation, "設定完了"    End Function
Sub 列_幅()
    '列幅を自動調整する
    With Selection(1)            If .ColumnWidth = 2 Then            Selection.ColumnWidth = 200                ElseIf .ColumnWidth = 200 Then            Selection.ColumnWidth = SetColumnWidthTo108Pixels                Else            Selection.ColumnWidth = 2                End If
    End With    End Sub

灰色列非表示

Sub 列_灰色列非表示()
    '選択範囲で灰色のセルの列を非表示にする。        Dim s As Worksheet    Dim r_start As Long    Dim r_end As Long    Dim c_start As Long    Dim c_end As Long    Dim i As Long    Dim j As Long
    If Selection.Rows.Count > 1 Then        MsgBox "1行だけ選択してください。"        Exit Sub    End If
    Selection.Columns.Hidden = False
    Set s = ActiveSheet    With s.UsedRange        r_start = .Row        r_end = .Row + .Rows.Count - 1        c_start = .Column        c_end = .Column + .Columns.Count - 1    End With        With Selection        If .Row > r_start Then            r_start = .Row        End If        If .Row + .Rows.Count - 1 < r_end Then            r_end = .Row + .Rows.Count - 1        End If        If .Column > c_start Then            c_start = .Column        End If        If .Column + .Columns.Count - 1 < c_end Then            c_end = .Column + .Columns.Count - 1        End If    End With        For j = c_start To c_end        If s.Cells(r_start, j).Interior.ColorIndex = 15 Or s.Cells(r_start, j).Interior.ColorIndex = 16 Then            s.Columns(j).Hidden = True        End If    Next j
End Sub