Wrap text(with more than 1024 characters) in Merged Cells in Excel Sheet using VBScript/VBA

Category:

Office/VBA

Type:

Applications

Difficulty:

Intermediate

Author:

Anonymous

Version Compatibility:

More information:

I was facing problem to wrap text in Excel sheet merged cells, when text is having more than 1024 charatcers. I have added 'Carriage Return' characters after each 100 characters, once first 1024 characters are passed.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Content of 'smemoPrevious' is as below. 1. I am happy to join with you today in what will go down in history as the greatest demonstration for freedom in the history of our nation. 2. I say to you today, my friends, so even though we face the difficulties of today and tomorrow, I still have a dream. It is a dream deeply rooted in the American dream. 3. I have a dream that one day this nation will rise up and live out the true meaning of its creed: "We hold these truths to be self-evident; that all men are created equal." 4. I have a dream that one day on the red hills of Georgia the sons of former slaves and the sons of former slave owners will be able to sit down together at the table of brotherhood. 5. I have a dream that one day even the state of Mississippi, a state sweltering with the heat of injustice, sweltering with the heat of oppression, will be transformed into an oasis of freedom and justice. 6. I have a dream that my four little children will one day live in a nation where they will not be judged by the color of their skin but by the content of their character. 7. I have a dream that one day down in Alabama, with its vicious racists, with its governor having his lips dripping with the words of interposition and nullification, that one day right down in Alabama little black boys and black girls will be able to join hands with little white boys and white girls as sisters and brothers.

Code:

Here is the code.

'Last character is added as Carriage return, if not found
LastCarriagereturn = InStrRev(smemoPrevious, Chr(13))
If LastCarriagereturn <> 1 Then
     smemoPrevious = smemoPrevious & chr(13)
End If

smemoleft = Left(smemoPrevious, 1024) 'First 1024 characters picked up, because up to these characters, no problem with Wrap text.

pos = InStrRev(smemoleft, Chr(13))  'position of 'carriage return' character found in string smemoleft from end/right side

smemoleft = Left(smemoPrevious, pos) 'leftside of string i.e. Main left string

smemoright = Right(smemoPrevious, len(smemo) - pos ) 'rightside of string

Oldstring = ""
While InStr(1, smemoright, Chr(13))  'loop will be executed until 'carriage return' character found in string.
     Enterkeypos = InStr(1, smemoright, Chr(13))

Oldstring = Mid(smemoright, 1, Enterkeypos - 1)
     smemoright = Right(smemoright, len(smemoright) - Enterkeypos )

If len(Oldstring) > 100 Then
          While ( len(Oldstring) > 100)
               smemolefttemp = Left(Oldstring, 100)
               spacepos = InStrRev(smemolefttemp, Chr(32))

smemolefttemp = Left(smemolefttemp, spacepos) 'leftside of Oldstring
               smemolefttemp = smemolefttemp & chr(10) 'Carriage return character added.
               OldString = Right(OldString, len(OldString) - spacepos ) ' remaining rightside of Oldstring
               smemoleft = smemoleft & smemolefttemp  'Main left string is added with smemolefttemp
               If len(Oldstring) <= 100 Then
                    smemoleft = smemoleft & Oldstring 'Main left string is added with Oldstring
               End If
          Wend
     Else
          smemoleft = smemoleft & Oldstring & Chr(10) 'Main left string is added with Oldstring and Carriage return character added
     End If
Wend

smemoPrevious = left(smemoleft, len(smemoleft) - 1) 'Last added carriage return characters is taken back away
----

Good Luck...