Results 1 to 7 of 7
  1. #1
    3 Star Lounger
    Join Date
    Nov 2005
    Location
    Asia Pacific, Bangkok Metropolis
    Posts
    378
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi

    EXcel 2003

    I have a Word document with questions and 4 multi-choices answers
    Is there a way to import these into Excel with the questions numbers in Col A,
    questions in Col B and and the 4 multi-choice answers in Col C,D,E and F respectively

    see attached
    Attached Files Attached Files
    Hope this is helpful

    francis, <img src=/S/cheers.gif border=0 alt=cheers width=30 height=16>

    My Reading

    Pivot Table 101
    Pivot Table
    Array

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Here's a macro that you can run in the Word document. When it finishes, there will be a table on the clipboard ready to be pasted into an Excel workbook.
    You can add the header row there and clean up the formatting.

    [codebox]
    Sub ConvertDoc()
    Dim c As String
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = False
    Do While .Execute(FindText:="^p^p", Replace:=wdReplaceNone)
    c = ActiveDocument.Range(Start:=Selection.End, End:=Selection.End + 1).Text
    If IsNumeric(c) Then
    Selection.Text = "@@@@"
    Selection.Collapse Direction:=wdCollapseEnd
    .Execute FindText:=".", ReplaceWith:="^t", Replace:=wdReplaceOne
    Else
    Selection.Text = vbTab
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Extend Character:=")"
    Selection.Delete
    End If
    Selection.Collapse Direction:=wdCollapseEnd
    Loop
    Selection.HomeKey Unit:=wdStory
    Do While .Execute(FindText:="^p", ReplaceWith:="^t", Replace:=wdReplaceOne) _
    And Selection.End < ActiveDocument.Content.End
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Extend Character:=")"
    Selection.Delete
    Loop
    Selection.HomeKey Unit:=wdStory
    .Execute FindText:="@@@@", ReplaceWith:="^p", Replace:=wdReplaceAll
    End With
    ActiveDocument.Content.ConvertToTable Separator:=wdSeparateByTabs
    ActiveDocument.Tables(1).Range.Copy
    End Sub[/codebox]

  3. #3
    3 Star Lounger
    Join Date
    Nov 2005
    Location
    Asia Pacific, Bangkok Metropolis
    Posts
    378
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='HansV' post='776563' date='23-May-2009 19:02']Here's a macro that you can run in the Word document. When it finishes, there will be a table on the clipboard ready to be pasted into an Excel workbook.
    You can add the header row there and clean up the formatting.

    [codebox]
    Sub ConvertDoc()
    Dim c As String
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = False
    Do While .Execute(FindText:="^p^p", Replace:=wdReplaceNone)
    c = ActiveDocument.Range(Start:=Selection.End, End:=Selection.End + 1).Text
    If IsNumeric© Then
    Selection.Text = "@@@@"
    Selection.Collapse Direction:=wdCollapseEnd
    .Execute FindText:=".", ReplaceWith:="^t", Replace:=wdReplaceOne
    Else
    Selection.Text = vbTab
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Extend Character:=")"
    Selection.Delete
    End If
    Selection.Collapse Direction:=wdCollapseEnd
    Loop
    Selection.HomeKey Unit:=wdStory
    Do While .Execute(FindText:="^p", ReplaceWith:="^t", Replace:=wdReplaceOne) _
    And Selection.End < ActiveDocument.Content.End
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.Extend Character:=")"
    Selection.Delete
    Loop
    Selection.HomeKey Unit:=wdStory
    .Execute FindText:="@@@@", ReplaceWith:="^p", Replace:=wdReplaceAll
    End With
    ActiveDocument.Content.ConvertToTable Separator:=wdSeparateByTabs
    ActiveDocument.Tables(1).Range.Copy
    End Sub[/codebox][/quote]

    Hans

    Thanks for providing a solution
    I got an error error message in the line highlight in red above
    It is telling me that variables not define

    Just to clarify that I am to run this in Word and not Excel?

    TIA
    Hope this is helpful

    francis, <img src=/S/cheers.gif border=0 alt=cheers width=30 height=16>

    My Reading

    Pivot Table 101
    Pivot Table
    Array

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Sorry, the Lounge automatically converted ( c ) to ©. I have corrected this; the line should have been

    If IsNumeric(c) Then

    The code should be run in Word, with the document open.
    After running the macro, switch to Excel and press Ctrl+V to paste the table into your workbook.

  5. #5
    3 Star Lounger
    Join Date
    Nov 2005
    Location
    Asia Pacific, Bangkok Metropolis
    Posts
    378
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [quote name='HansV' post='776565' date='23-May-2009 19:23']Sorry, the Lounge automatically converted ( c ) to ©. I have corrected this; the line should have been

    If IsNumeric(c) Then

    The code should be run in Word, with the document open.
    After running the macro, switch to Excel and press Ctrl+V to paste the table into your workbook.[/quote]

    Hans

    Thanks, this work well. Is it not possible to run this codes from Excel?

    TIA
    Hope this is helpful

    francis, <img src=/S/cheers.gif border=0 alt=cheers width=30 height=16>

    My Reading

    Pivot Table 101
    Pivot Table
    Array

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts
    Here is a version that you can run from Excel. You'll be prompted to select a Word document.

    [codebox]Sub ConvertDoc()
    Dim wrdApp As Object
    Dim c As String
    Dim wbk As Workbook
    'On Error GoTo ErrHandler
    Set wrdApp = CreateObject("Word.Application")
    If wrdApp.Dialogs(80).Show = True Then
    wrdApp.Visible = False
    wrdApp.Selection.HomeKey Unit:=6 ' wdStory
    With wrdApp.Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = False
    Do While .Execute(FindText:="^p^p", Replace:=0) ' wdReplaceNone
    c = wrdApp.ActiveDocument.Range(Start:=wrdApp.Selectio n.End, _
    End:=wrdApp.Selection.End + 1).Text
    If IsNumeric(c) Then
    wrdApp.Selection.Text = "@@@@"
    wrdApp.Selection.Collapse Direction:=0 ' wdCollapseEnd
    .Execute FindText:=".", ReplaceWith:="^t", Replace:=1 ' wdReplaceOne
    Else
    wrdApp.Selection.Text = vbTab
    wrdApp.Selection.Collapse Direction:=0
    wrdApp.Selection.Extend Character:=")"
    wrdApp.Selection.Delete
    End If
    wrdApp.Selection.Collapse Direction:=0
    Loop
    wrdApp.Selection.HomeKey Unit:=6
    Do While .Execute(FindText:="^p", ReplaceWith:="^t", Replace:=1) _
    And wrdApp.Selection.End < wrdApp.ActiveDocument.Content.End
    wrdApp.Selection.Collapse Direction:=0
    wrdApp.Selection.Extend Character:=")"
    wrdApp.Selection.Delete
    Loop
    wrdApp.Selection.HomeKey Unit:=6
    .Execute FindText:="@@@@", ReplaceWith:="^p", Replace:=2 ' wdReplaceAll
    End With
    wrdApp.ActiveDocument.Content.ConvertToTable Separator:=1 ' wdSeparateByTabs
    wrdApp.ActiveDocument.Tables(1).Range.Copy
    Set wbk = Workbooks.Add(Template:=xlWBATWorksheet)
    wbk.Worksheets(1).Paste
    Selection.WrapText = False
    End If

    ExitHandler:
    On Error Resume Next
    wrdApp.Quit SaveChanges:=False
    Set wrdApp = Nothing
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    End Sub[/codebox]

  7. #7
    3 Star Lounger
    Join Date
    Nov 2005
    Location
    Asia Pacific, Bangkok Metropolis
    Posts
    378
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hans

    Thanks, its work extremely well.

    I appreciate your time and effort on this
    Hope this is helpful

    francis, <img src=/S/cheers.gif border=0 alt=cheers width=30 height=16>

    My Reading

    Pivot Table 101
    Pivot Table
    Array

Posting Permissions

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