convert_cell_to_shape.xlsm

Option Explicit
'セルを全て図形に変換する
    
Sub main()
    Dim row As Long
    Dim col As Long
    Dim maxrow As Long
    Dim maxcol As Long
    
    '対象範囲指定
    maxrow = 1000
    maxcol = 1000
    
    For row = 1 To maxrow
        For col = 1 To maxcol
        'セル内に文字が入っていれば、オートシェイプに変換
        If Cells(row, col).Value <> "" Then
            convertCellToShape (Cells(row, col))
        End If
        Next col
    Next row

End Sub

Sub convertCellToShape(cell)
    Dim w As Integer
    Dim h As Integer
    Dim txt As String
    Dim font_color As Long
    Dim border_color As Long
    Dim back_color As Long
    
    'セル情報取得
    w = cell.Width
    h = cell.Height
    txt = cell.Value
    font_color = cell.Font.Color
    border_color = cell.Borders.Color
    back_color = cell.Interior.Color
    
    '図形生成
    With ActiveSheet.Shapes.AddShape _
     (msoShapeRectangle, cell.Left, cell.Top, w, h)
     .TextFrame.Characters.Text = txt
     .TextFrame.Characters.Font.Color = font_color
     .TextFrame.HorizontalAlignment = xlHAlignCenter
     .TextFrame.VerticalAlignment = xlVAlignCenter
     .Line.ForeColor.RGB = border_color
     .Fill.ForeColor.RGB = back_color
    End With

End Sub