'VBA - Label lose text after paste

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


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source