Missing Formating going from Word to Excel

[heedaf]

I'm trying to move a few lines from Word to a cell in Excel and keep the bullets (formating)

• one
• two
• three

I've tried using

Sub test()    
Dim rng As Range   
Dim EXCL As Object    

Set rng = ActiveDocument.Range   
Set EXCEL = GetObject(, "Excel.Application")        

rng.copy 

EXCEL.Activesheet.Cells(1, 1).pastespecial

End Sub

But it pastes as an image in Excel. I've tried multiple examples of pastespecial but nothing works.
Any ideas?

[macropod]

You should learn to use Option Explicit at the top of your code. Your 'Set EXCEL = GetObject(, "Excel.Application")' line does not refer to the object defined by 'Dim EXCL As Object'. Furthermore, sending FormattedText to a string variable (per 'Dim str As String') is meaningless. String variables cannot retain formatting.

As for extracting the bullets (and any other automatic numbering) you need to apply the .ConvertNumbersToText method to the document.

If you want to preserve formatting, you will need to do it via copy/paste.

Finally, if you want the content to all go into one cell, that means removing all tabs & paragraph breaks from the document before copying, then restoring the paragraph breaks afterwards.

[heedaf]

You should learn to use Option Explicit at the top of your code. Your 'Set EXCEL = GetObject(, "Excel.Application")' line does not refer to the object defined by 'Dim EXCL As Object'. Furthermore, sending FormattedText to a string variable (per 'Dim str As String') is meaningless. String variables cannot retain formatting.

As for extracting the bullets (and any other automatic numbering) you need to apply the .ConvertNumbersToText method to the document.

If you want to preserve formatting, you will need to do it via copy/paste.

Finally, if you want the content to all go into one cell, that means removing all tabs & paragraph breaks from the document before copying, then restoring the paragraph breaks afterwards.

I was adding chr(140) to the string (seems to work) but forgot to remove that part when I posted and removed it later. I figured the copy/paste would be the easiest but I can't figure out how to do it from Word into Excel. "cells.(1,1).Paste" gives me an error and when I try "cells(1,1).pastespecial" all I get is an image. It seems that the paste part is different going from Word to Excel. Pasting manually into Excel I have to click on the formula bar and then paste it. I see what you mean by removing tabs and paragraphs but is there a way of "clicking" on the formula bar in excel via VBA - does that make sense? I would assume there would be an straight forward way of doing this but I can't figure it out.

[macropod]

For example:

Sub Demo()
Application.ScreenUpdating = False
Dim xlObj As Object
With ActiveDocument
  .ConvertNumbersToText (wdNumberAllNumbers)
  With .Range
    Do While .Characters.Last.Previous = vbCr
      .Characters.Last.Previous.Delete
    Loop
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindContinue
      .Text = "^p"
      .Replacement.Text = Chr(182)
      .Execute Replace:=wdReplaceAll
      .Text = "^t"
      .Replacement.Text = Chr(32)
      .Execute Replace:=wdReplaceAll
    End With
    .Copy
  End With
End With
Set xlObj = GetObject(, "Excel.Application")
With xlObj.Activesheet
  .Paste Destination:=.Range("A1")
  .Range("A1").Replace Chr(182), Chr(10), 2, 1
End With
Set xlObj = Nothing
Application.ScreenUpdating = True
End Sub

[heedaf]

For example:

Sub Demo()
Application.ScreenUpdating = False
Dim xlObj As Object
With ActiveDocument
  .ConvertNumbersToText (wdNumberAllNumbers)
  With .Range
    Do While .Characters.Last.Previous = vbCr
      .Characters.Last.Previous.Delete
    Loop
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindContinue
      .Text = "^p"
      .Replacement.Text = Chr(182)
      .Execute Replace:=wdReplaceAll
      .Text = "^t"
      .Replacement.Text = Chr(32)
      .Execute Replace:=wdReplaceAll
    End With
    .Copy
  End With
End With
Set xlObj = GetObject(, "Excel.Application")
With xlObj.Activesheet
  .Paste Destination:=.Range("A1")
  .Range("A1").Replace Chr(182), Chr(10), 2, 1
End With
Set xlObj = Nothing
Application.ScreenUpdating = True
End Sub

Wow! Thank you. I thought I tried ".Paste Destination:=.Range("A1")" and got an error. But that works great. Thank you again.

[macropod]

Do note that Excel's .Range.Replace method wipes out most of the copied formatting (bold, italics, etc.) as well as reducing the bullets to little more than dots. I'm not sufficiently well-versed with Excel VBA to know how to avoid that. If you omit that line, you'll see all that formatting is intact at the time of pasting.