pgbigorokuのブログ

プログラムの再利用できそうなコードをアップ

EXCEL VBA シートの中の部分表の幅をコピーする

'シートの中の部分表の幅をコピーする
'
'
'   ByRef pshtFrom As Worksheet
'   ByVal plngFromStartRow As Long
'   ByVal pintFromStartCol As Integer
'   ByVal plngFromStartRow As Long       0なら最終行
'   ByVal pintFromEndCol As Integer
'   ByVal pshtTo As Worksheet
'   ByVal plngToStartRow As Long
'   ByVal pintToStartCol As Integer
'
'2022/8/15
'
'必要関数URL https://pgbigoroku.hatenablog.com/entry/2022/08/13/155625
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/14/193651

Private Sub psubシートの中の部分表の幅をコピーする(ByRef pshtFrom As Worksheet, _
                                            ByVal plngFromStartRow As Long, _
                                            ByVal pintFromStartCol As Integer, _
                                            ByVal plngFromEndRow As Long, _
                                            ByVal pintFromEndCol As Integer, _
                                            ByVal pshtTo As Worksheet, _
                                            ByVal plngToStartRow As Long, _
                                            ByVal pintToStartCol As Integer)
    Dim lngForRow As Long
    Dim intForCol As Integer
    Dim dblTemp As Double
    If plngFromEndRow = 0 Then
        plngFromEndRow = plngGetLastRow(pshtFrom, pintFromStartCol)
    End If
    pshtFrom.Parent.Activate
    pshtFrom.Select
    '行
    For lngForRow = plngFromStartRow To plngFromEndRow
        dblTemp = pshtFrom.Range(pshtFrom.Cells(lngForRow, pintFromStartCol), pshtFrom.Cells(lngForRow, pintFromStartCol)).RowHeight
        pshtTo.Rows(plngToStartRow + lngForRow - plngFromStartRow).RowHeight = dblTemp
       ' Debug.Print Range(Cells(lngForRow, pintFromStartCol), Cells(lngForRow, pintFromStartCol)).RowHeight
    Next
    '列
    For intForCol = pintFromStartCol To pintFromEndCol
        dblTemp = pshtFrom.Range(pshtFrom.Cells(plngFromStartRow, intForCol), pshtFrom.Cells(plngFromStartRow, intForCol)).ColumnWidth
        pshtTo.Columns(pintToStartCol + intForCol - pintFromStartCol).ColumnWidth = dblTemp
    Next

End Sub