'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 |
|---|
