Results 1 to 4 of 4
  1. #1
    Lounger
    Join Date
    Dec 2001
    Posts
    48
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Excel Rows To Text (2000/SR1)

    I need a VBA code to do the following:
    Say, A1, B1, A2, B2 contain text of say, a variable number 500 characters. I want to get A1's the first 75 char in line 1, then 76 to 150 char in line 2 and so on. When EOF reached, move on to B1, do same, then A2 and B2 UNTIL a blank row is encountered. It is a kind of word wrap for a page width of 75 char. The 'wrap' preferably should occur at a convenient SPACE char. The output is to an ASCII file or if not possible, another WorkSheet (I can Copy/Paste from this to a blank ASCII file). I have tried by exporting to Access and create a report. But the resulting ASCII file's spacing for rows gets messed and some long texts get truncated. I am hoping for more 'process control' via the VBA. Based on previous experience the loungers can produce very elegant codes! My VBA code ended up rather long trying to add criteria for the 'wrap' feature and to determine EOF. I am short on 'fuctions' knowledge. Thanks for assistance.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Excel Rows To Text (2000/SR1)

    Here is a beginning. It is not finished - there is no error handling for instance. Perhaps you or others can adapt it. I made it in Excel 97. In Excel 2000 it can be simplified a bit by using InstrRev.

    You can assign the macro WrapCells to a keyboard shortcut or a toolbar button if you like, or call it from Tools/Macro/Macros (Alt+F8). It acts on the selected range of cells.

    <img src=/w3timages/blueline.gif width=33% height=2><img src=/w3timages/blueline.gif width=33% height=2>

    Const intLen = 75

    Sub WrapCells()
    Dim aCell As Range
    For Each aCell In Selection
    ' Loop through all cells in the selected range.
    WrapCell aCell
    Next aCell
    Selection.WrapText = True
    Selection.ColumnWidth = intLen
    End Sub

    Sub WrapCell(aCell As Range)
    Dim strVal As String
    Dim intPos As Integer
    Dim intPrev As Integer
    ' Get value of cell
    strVal = aCell.Value
    intPrev = 0
    intPos = intLen
    Do While intPos <= Len(strVal)
    ' Go on while string is not exhausted.
    Do While (Mid(strVal, intPos, 1) <> " ") And (intPos > intPrev)
    ' Move backwards looking for a space.
    intPos = intPos - 1
    Loop
    If intPos = intPrev Then
    ' Out of luck! Don't know what to do now.
    Else
    ' Found a space. Replace by line feed.
    Mid(strVal, intPos, 1) = vbLf
    End If
    intPrev = intPos
    intPos = intPrev + intLen
    Loop
    ' Replace value in cell
    aCell.Value = strVal
    End Sub

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Excel Rows To Text (2000/SR1)

    You posted an additional question, but it has been lost because of problems with the Lounge in the early morning of May 6, 2002.

    You want to export cells with long text values to an ASCII file with at most 75 characters on a line.

    A variation of my earlier post may help. In this example, the name of the output file is hard-coded in a constant. Of course, you can make it into a variable.

    The code first opens a text file for output.
    Then it loops through all cells in the selected range, tries to split the text into pieces at most 75 characters long and writes these pieces to the output file using Print. If you want quotes around the text, use Write instead of Print.
    Finally, the output file is closed.

    As in my earlier post, there is no error handling. And the code won't break words that are more than 75 characters long, but that shouldn't be a problem in most languages. Even Llanfairpwllgwyngyllgogerychwyrndrobwllllantysilio gogogoch (a village in Wales) is only 58 characters.

    <img src=/w3timages/blueline.gif width=33% height=2><img src=/w3timages/blueline.gif width=33% height=2>

    ' Optimal line length
    Const intLen = 75
    ' File name - change as desired
    Const strFilename = "C:Test.txt"

    Sub WriteCells()
    Dim intFile As Integer
    Dim aCell As Range
    ' Obtain available file number
    intFile = FreeFile
    ' Open output text file
    Open strFilename For Output As intFile
    ' Loop through all cells in the selected range.
    For Each aCell In Selection
    WriteCell aCell, intFile
    Next aCell
    ' Close output file
    Close #intFile
    End Sub

    Sub WriteCell(aCell As Range, intFile As Integer)
    Dim strVal As String
    Dim intPos As Integer
    Dim intPrev As Integer
    ' Get value of cell
    strVal = aCell.Value
    intPrev = 0
    intPos = intLen
    Do While intPos <= Len(strVal)
    ' Go on while string is not exhausted.
    Do While (Mid(strVal, intPos, 1) <> " ") And (intPos > intPrev)
    ' Move backwards looking for a space.
    intPos = intPos - 1
    Loop
    If intPos = intPrev Then
    ' Out of luck! Don't know what to do now.
    Else
    ' Found a space. Write part of string to file
    Print #intFile, Mid(strVal, intPrev + 1, intPos - intPrev - 1)
    End If
    intPrev = intPos
    intPos = intPrev + intLen
    Loop
    ' Write last part of string to file
    Print #intFile, Mid$(strVal, intPrev + 1)
    End Sub

  4. #4
    Lounger
    Join Date
    Dec 2001
    Posts
    48
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Excel Rows To Text (2000/SR1)

    Thanks a million. This code works just great. Solves a handicap that I have been mulling over for months!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •