Bulk paste cell content into shape

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows
I'm a big fan of this forum as it has helped me with coding more times than I can count, but I think I've finally found a question that hasn't been asked yet.

Scenario: I have an excel workbook with a large number of worksheets and each sheet has a number of shapes on them with associated text. I need to translate all this text, so I was looking to do it the easiest way possible. I was able to get the following code to work to copy all the shape text into one worksheet. Worked like a charm!

VBA Code:
Private Sub CommandButton1_Click()
Dim WS_Count As Integer
         Dim I As Integer
         Dim shp As Shape
Dim strText As String

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

For Each shp In Worksheets(I).Shapes

On Error Resume Next
strText = shp.TextFrame.Characters.Text
If Err.Number > 0 Then
Err.Clear
Else
If Len(strText) > 0 Then
Cells(Me.Rows.Count, 1).End(xlUp).Offset(1).Value = strText
End If
End If

Next

         Next I
End Sub


I have a lovely worksheet that has all the text in every shape. What I want to do now is input the french in the cell next to it and then clicking the next command button, it runs through the shapes and replaces the text with the french. I thought it would be as simple as inverting the initial code, but it has proven more tricky than that. Here is what I have:

VBA Code:
Private Sub CommandButton2_Click()

Dim WS_Count As Integer
         Dim I As Integer
         Dim cell As Integer
        
         Dim shp As Shape
Dim strText As String

cell = 2

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

For Each shp In Worksheets(I).Shapes
On Error Resume Next
If Err.Number > 0 Then
Err.Clear
Else
If Len(strText) > 0 Then
strText = Me.Cells(2, cell).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1
End If
End If

Next

         Next I

End Sub

It doesn't seem to do anything.

If someone can solve this for me I'd be forever grateful! Thank you in advance!
 
Last edited by a moderator:

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
3,549
Office Version
  1. 365
Platform
  1. Windows
Hi, @mdubs91

Try it without checking the string:
Rich (BB code):
If Len(strText) > 0 Then
strText = Me.Cells(2, cell).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1
End If


And where is the French text located, in row 2 or col B?
If it's in col B then it should be:
VBA Code:
strText = Me.Cells(cell, 2).Value
 

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows
Hi, @mdubs91

Try it without checking the string:
Rich (BB code):
If Len(strText) > 0 Then
strText = Me.Cells(2, cell).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1
End If


And where is the French text located, in row 2 or col B?
If it's in col B then it should be:
VBA Code:
strText = Me.Cells(cell, 2).Value
Thanks for responding so quickly Akuini. The column is indeed B and starts at row 2, so I made the updates as suggested:

Private Sub CommandButton2_Click()

Dim WS_Count As Integer
Dim I As Integer
Dim cell As Integer

Dim shp As Shape
Dim strText As String

cell = 2

' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.
For I = 1 To WS_Count

For Each shp In Worksheets(I).Shapes
On Error Resume Next
If Err.Number > 0 Then
Err.Clear
Else
strText = Me.Cells(cell, 2).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1
End If

Next

Next I

End Sub


The effect that happens now is the code runs through, but all it does is delete the content in every shape. It does not take the content I've put in column B into each shape.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,724
Office Version
  1. 2010
Platform
  1. Windows
Hi,​
the easy way :​
column A : sheet name​
column B : shape name​
column C : native text​
column D : french text​
et voilà !​
 

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows

ADVERTISEMENT

Hi, @mdubs91

Try it without checking the string:
Rich (BB code):
If Len(strText) > 0 Then
strText = Me.Cells(2, cell).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1
End If


And where is the French text located, in row 2 or col B?
If it's in col B then it should be:
VBA Code:
strText = Me.Cells(cell, 2).Value
I've also tinkered with the coding and come up with:

Private Sub CommandButton2_Click()

Dim WS_Count As Integer
Dim I As Integer
Dim cell As Integer
Dim shp As Shape
Dim strText As String

cell = 2

' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.
For I = 1 To WS_Count

For Each shp In Worksheets(I).Shapes
On Error Resume Next

strText = Me.Cells(cell, 2).Value
shp.TextFrame.Characters.Text = strText
cell = cell + 1

Next

Next I
End Sub


It runs through and replaces things with my test content, "Test 1", "Test 2", etc. but when I rerun command button 1, it clearly didn't work as expected as it wrote Test 21, to what should be the first shape, test 23 to 2 and so on....It skips over a bunch of shapes for a reason I can't identify.
 

Marc L

Well-known Member
Joined
Apr 5, 2021
Messages
1,724
Office Version
  1. 2010
Platform
  1. Windows
Well read post #4 as with this obvious logic you can't have any issue …​
 

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows

ADVERTISEMENT

Hi,​
the easy way :​
column A : sheet name​
column B : shape name​
column C : native text​
column D : french text​
et voilà !​
Hi Mark,

I'm all about easy, but my mind doesn't comprehend how to code this. I presume I would need to populate a listing of sheets/shapes, but is there a fast way to do this without doing it all manually?

If you could provide some coding to me that would be great, as I'm not sure where to start.
 

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows
How this sheet was created ?​
I inserted a new worksheet into the workbook, added command button 1 and 2 with the above coding. When I click command button 1, this new worksheet populates with the text from all shapes in the entire workbook.
 

mdubs91

New Member
Joined
Jun 10, 2021
Messages
6
Office Version
  1. 365
  2. 2013
  3. 2010
Platform
  1. Windows
Figured it out!

Private Sub CommandButton2_Click()



Dim WS_Count As Integer

Dim I As Integer

Dim cell As Integer

Dim shp As Shape

Dim strText As String

Dim strText2 As String





cell = 2



' Set WS_Count equal to the number of worksheets in the active

' workbook.

WS_Count = ActiveWorkbook.Worksheets.Count



' Begin the loop.

For I = 1 To WS_Count



For Each shp In Worksheets(I).Shapes

On Error Resume Next

strText2 = shp.TextFrame.Characters.Text

If Err.Number > 0 Then

Err.Clear

Else

If Len(strText2) > 0 Then

strText = Me.Cells(cell, 2).Value

shp.TextFrame.Characters.Text = strText

cell = cell + 1

End If

End If

Next



Next I

End Sub

It only copies the text though, so if anyone knows how to bring the formatting (some words in the bubbles are bolded), that would be the cherry on top. Thanks all!
 
Solution

Forum statistics

Threads
1,147,562
Messages
5,741,848
Members
423,691
Latest member
Fahad987

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top