PDA

View Full Version : Help on word to excel



sampath_123
03-10-2009, 08:06 AM
Option Explicit

Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
'Change the file path to match the location of your test.xls
Set objSheet = appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set aRange = Nothing
End Sub


Hi all
i am working on a similar macro but got struck with some problem


Ex: If doument contains sentence like

I shall


do it now

---------
Is there any possible way to exclude the spaces and extract the complete sentence "I shall do it now"

please help me

fumei
03-10-2009, 11:44 AM
I shall


do it now


Well, what if that is NOT a sentence? It does not look like a sentence. If there is a paragraph mark after "I shall", then it is NOT a sentence.

However, if those are manual line breaks (not paragraph marks) then yes you can get rid of them.

fumei
03-10-2009, 12:01 PM
With aRange.Find
Do While .Execute(FindText:="shall", _
Forward:=True) = True
aRange.Expand Unit:=wdSentence
If InStr(1, aRange.Text, Chr(11)) > 0 Then
aRange.Text = Replace(aRange.Text, _
Chr(11), "")
End If
With aRange
.Copy
.Collapse wdCollapseEnd
End With
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
' Change the file path to match the location "
' of your test.xls
Set objSheet = _
appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
intRowCount = 1
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop
End With

If those are manual line breaks - Chr(11) - then the code above expanding the sentence WILL include them, and then delete them.

If those are paragraph marks, then you will need different coding.

fumei
03-10-2009, 12:05 PM
Note that if you use .Execute(parameters)=True then you do not need to use the If .Found.

The instructions following .execute will only fire if the Findtext IS found. The method .Execute only returns a True if a .Found is True. A .Execute returns a False if .Found is False.

sampath_123
03-10-2009, 09:56 PM
hi all

I need help in appending two sentences

Ex : Hi
i am sampath


these are two separate sentences and i want to make it one sentence as "Hi i am sampath"

i am unable to do it with normal conctination operator & and i have even tried to insert a back space character VbBack it is even not working please help me.

sampath_123
03-10-2009, 09:57 PM
Thanks for your Help fumei

lucas
03-11-2009, 07:15 AM
You don't clarify but is there a paragraph mark after "Hi"?

If so do a find and replace:

whole document:

Option Explicit
'whole document
Sub RemoveLineBreaks()
With ActiveDocument.Content.Find
.Text = ".^p"
.Replacement.Text = "zzzz"
.Execute Replace:=wdReplaceAll
.Text = "^p"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
.Text = "zzzz"
.Replacement.Text = ".^p "
.Execute Replace:=wdReplaceAll
End With
End Sub


Selection only:
Sub RemoveLineBreaks2()
With Selection.Find
.Text = ".^p"
.Replacement.Text = "zzzz"
.Execute Replace:=wdReplaceAll
.Text = "^p"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
.Text = "zzzz"
.Replacement.Text = ".^p "
.Execute Replace:=wdReplaceAll
End With
End Sub

lucas
03-11-2009, 07:20 AM
Threads with the same question asked merged into one.

Starting multiple thread asking the same question doesn't make it easier for us to help you. Please keep one question in one thread only.