Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment