列の表示／非表示をコントロール（続き） - Infomentのブログ～Excel VBA奮闘記～

こちら ↓ で作成したユーザーフォームについて、「列のコピーに使用できないか」というコメントがありました。

infoment.hatenablog.com

非表示列をそのままコピーすると貼り付け先でも非表示のままであるため、一手間必要になります。そこでチェックボックスを設け、表示化／非表示化を選択可能にしたうえで、リストボックス内で選択した列をコピーするところまで作ってみました。

Private Sub CommandButton1_Click() ' 閉じるボタン
    Unload Me
End Sub

Private Sub CommandButton2_Click() ' 全選択ボタン

    Dim myFlag  As Boolean
    Dim i       As Long
    
    Select Case CommandButton2.Caption
        Case "全選択"
            myFlag = True
            CommandButton2.Caption = "全解除"
        Case "全解除"
            myFlag = False
            CommandButton2.Caption = "全選択"
    End Select
    
    If CheckBox1.Value = True Then
        Range("A:" & getColumnLetter(100)).EntireColumn.Hidden = myFlag
    End If
    
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = myFlag
    Next

End Sub

Private Sub CommandButton3_Click() ' 選択コピーボタン
    
    Dim copyRange As Range
    Dim i As Long
    
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            If copyRange Is Nothing Then
                Set copyRange = Columns(i + 1)
            Else
                Set copyRange = Union(copyRange, Columns(i + 1))
            End If
        End If
    Next
    
    copyRange.Copy

End Sub

Private Sub ListBox1_Mouseup(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Dim i As Long
    
        If CheckBox1.Value = False Then Exit Sub
    
        Columns.Hidden = False
        For i = 1 To ListBox1.ListCount
            Columns(i).Hidden = ListBox1.Selected(i - 1)
        Next

End Sub

Private Sub UserForm_Initialize()

    Dim seq(1 To 100) As Variant
    Dim i As Long
    Dim j As Long
    
    j = 0
    
    For i = 1 To 100
        ListBox1.AddItem StrConv(getColumnLetter(i) & "列（" & i & "列)", vbWide)
        If Columns(i).Hidden = True Then
            ListBox1.Selected(i - 1) = True
        Else
            j = j + 1
        End If
    Next
    
    If j = 100 Then
        CommandButton2.Caption = "全選択"
    Else
        CommandButton2.Caption = "全解除"
    End If


End Sub

' akashi-keirin さんから紹介いただいた関数を使用
' http://akashi-keirin.hatenablog.com/entry/2017/08/27/171615

Public Function getColumnLetter(ByVal columnNumber As Long) As String
On Error GoTo errorHandler
  Dim Sh As Worksheet    '……(1)'
  Set Sh = ActiveSheet
  Dim tmpStr As String
  tmpStr = Sh.Cells(1, columnNumber).Address    '……(2)'
  Dim tmpArray As Variant
  tmpArray = Split(tmpStr, "$")   '……(3)'
  getColumnLetter = tmpArray(1)    '……(4)'
  Exit Function
errorHandler:
  getColumnLetter = ""
End Function