View Single Post
 
Old 05-21-2015, 09:57 PM
excelledsoftware excelledsoftware is offline Windows 8 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Well this turned out to be more of a learning experience than I anticipated. You mentioned that you wanted to understand so I went ahead and split out this working code into sections.

First off the code
Code:
Option Explicit
Sub CovertTextToShape()

  '***SECTION A***
  'Goes through each line of data and holds it into a string.
  'This string is formatted to be placed inside of the shape.
  Dim wb As Workbook, dws As Worksheet, ows As Worksheet
  Dim CheckRow As Long, LastRow As Long, HoldString As String
  Dim Oshp As Shape, CheckCol As Integer, UseCol As Integer
  Dim CountData As Long, StartRow As Integer
  
  '***SECTION B***
  'Set the variables
  Set wb = ThisWorkbook
  Set dws = wb.Worksheets("Data to be put in textbox") 'use the worksheet name
  Set ows = wb.Worksheets("Output textbox")
  Set Oshp = ows.Shapes("TextBox 1")
  UseCol = 0
  StartRow = 0
  
  '***SECTION C***
  'Search out where to get data
  For CheckRow = 2 To 50
    CountData = WorksheetFunction.CountA(dws.Range("A" & CheckRow & ":IV" & CheckRow))
    If CountData > 0 Then
      'Find the column to use
      For CheckCol = 1 To 50
        If dws.Cells(CheckRow, CheckCol).Value <> "" Then
          StartRow = CheckRow
          UseCol = CheckCol
          Exit For
        End If
      Next CheckCol
      Exit For
    End If
  Next CheckRow
  
  '***SECTION D***
  'Show messages if there are any issues
  If StartRow = 0 Then
    MsgBox "Cannot find in data in first 10 rows to parse through. Program ending"
    End
  End If
  
  If UseCol = 0 Then
    MsgBox "Cannot find data in any column to use. Program ending."
    End
  End If
  
  '***SECTION E***
  'No issues program can continue
  LastRow = dws.Cells("50000", UseCol).End(xlUp).Row
  
  '***SECTION F***
  'This version DID NOT WORK
  'HoldString = ""
  'For CheckRow = StartRow To LastRow
  '  HoldString = HoldString & dws.Cells(CheckRow, UseCol).Value & vbLf
  'Next CheckRow
  'Oshp.TextFrame.Characters.Text = HoldString
  
  '***SECTION G***
  For CheckRow = StartRow To LastRow
    CountData = Oshp.TextFrame.Characters.Count + 1
    Oshp.TextFrame.Characters(CountData).Insert String:=(dws.Cells(CheckRow, UseCol).Value & vbLf)
    'Oshp.TextFrame.Characters.Text = Oshp.TextFrame.Characters.Text & dws.Cells(CheckRow, UseCol).Value & vbLf
  Next CheckRow
  
  'Apply any formatting to the shape here.

  
End Sub
Now the explanations.
Section A
This is where you set up all of the variables to use. I have a very distinct way of how I name my variables. some might say I use long names but the reason I do not abbreviate is so I always know when something is a variable and not a built in function.

You will also notice that there are data types like Long, Integer, String etc. I will not go over those here since that it is a pretty long explanation.

Section B
Here we SET the references. This is not the same as x = 1 or similar, this is setting a reference so that Excel knows what I want it to refer to when I type wb or ows. This is useful so you do not have to keep typing the same thing. For example
Code:
x = thisworkbook.worksheets("Data to be put in textbox").Range("A1").value
'is the same as
x = dws.Range("A1").value
'When you set the references.
We also set startrow and endrow = 0. Even though when these variables are declared in Section A they are given a value of 0 this is just good practice.

Section C
Here we use the counta function to see where the data starts. We do this because when someone copies and pastes text onto a worksheet it may not always end up in column D or wherever. After we identify where the data starts we find the column. Once the column is found we set the values of those variables and then exit the for loops.

Section D
Anytime you code a program you always need to be ready for issues. In the event someone ran this code with nothing on the paste sheet we want it to let us know rather than try to run. Thats why we set the variables usecol and startrow to 0. In the event Section C did not find data it would get here, display the message, and then end the program.

Section E
No issues time to identify where we need to stop. We use a .End built-in function to find the last row. Doing it this way allows for blank cells or carriage returns. If you wanted to eliminate that you could change the code to
Code:
LastRow = dws.cells("2", UseCol).End(xlDown).Row
Section F
Lets let this section stand for FooBARRED basically I wanted to save all of the data in 1 string and then put it into the shape. Surprise Excel wont let you do that. I had to use the macro recorder to identify how to add data to existing text in the shape, which brings us to Section G

Section G
After all that here is where the data is put into the shape. There were no periods so we add the code VBLF to make a carriage return after each string. This worked no problem for me so hopefully it works ok for you.

if for some reason you want to clear out what is in the shape before you run this code just add this snippet after you set Oshp
Code:
Oshp.TextFrame.Characters.Text = ""

Please let me know if you have any issues with the code of if you have any other questions.

Thanks
Reply With Quote