VBA - Label lose text after paste - excel

Question

So, I'm trying to create "cards" that the user can move around even when the the workbook is locked. Each card will contain info about a certain project.
The way I'm doing it:
Create a few shapes (an rectangle and a few labels and icons)
Group them
Cut the group
Paste as image
The problem is that when I paste as image, all labels loose their text, they change back to "label1".
If I run the code line by line, they don't lose the text.
I've tried already to add "time" between the cut and paste, adding some lines of code, moving the paste line to a separated sub, and even using Application.Wait(), but nothing worked.
I need to have them as an image (or one solid object - just a group doesn't work), because after the macro is finished, the worksheet is locked back again, and there is another macro to allow the user to move shapes even when the workbook is locked.
Here is a sample to show the problem.
Sub MyCode()
Set wkm = Workbooks(ThisWorkbook.Name)
Set wsm = wkm.Worksheets("TestSheet")
'Just two labels as exemple, the original code has more labels, more icons, and the rounded rectangle)
'The values for the constructors in the original code are defined by the user by a forms
Call GenerateLabel("plaseWork", "Name of the project", 14, 30)
Call GenerateLabel("whyCantYouJustWork", "Name of the user", 42, 30)
wsm.Shapes.Range(Array("plaseWork", "whyCantYouJustWork")).Group.Name = "myGroup"
Set freeSlot = wsm.Range("B10") 'Just a random cell, in the original code there is a function to define the position
Application.CutCopyMode = False
wsm.Shapes("myGroup").Cut
With wsm.Pictures.Paste
.left = freeSlot.left
.top = freeSlot.top
End With
Application.CutCopyMode = False
Set card = wsm.Pictures(wsm.Pictures.Count)
card.Name = "card" & projectName
End Sub
Sub GenerateLabel(labelDescription As String, projectName As String, top As Integer, left As Integer)
Set lbLabel = wsm.OLEObjects.Add(ClassType:="Forms.Label.1")
With lbLabel
.Name = labelDescription
.Object.BackStyle = fmBackStyleTransparent
.Width = 160
.top = top
.left = left
End With
With wsm
.OLEObjects(lbLabel.Name).Object.Caption = projectName
.Shapes(lbLabel.Name).Fill.Transparency = 1
End With
End Sub

Answer 1

What about using shapes with no outline or fill, in place of labels?
Sub MyCode()
Dim wsm As Worksheet, arr(0 To 1), grp As Shape
Set wkm = Workbooks(ThisWorkbook.Name)
Set wsm = wkm.Worksheets("TestSheet")
arr(0) = AddLabel(wsm, "Name of the project", 14, 30).Name
arr(1) = AddLabel(wsm, "Name of the user", 42, 30).Name
Set freeSlot = wsm.Range("B10") 'Just a random cell, in the original code there is a function to define the position
wsm.Shapes.Range(arr).Group.Cut
With wsm.Pictures.Paste
.left = freeSlot.left
.top = freeSlot.top
End With
Set card = wsm.Pictures(wsm.Pictures.Count)
card.Name = "card" & projectName
End Sub
'Add a shape to a worksheet, with the text provided.
' Return the added shape
Function AddLabel(ws As Worksheet, projectName As String, top As Integer, left As Integer)
Dim shp
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, left, top, 160, 30)
With shp
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
With .TextFrame2.TextRange.Characters
.Text = projectName
.Font.Fill.ForeColor.RGB = vbBlack
.Font.Size = 14
End With
End With
Set AddLabel = shp
End Function