| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Get Data from Word to Excel
Pls ignore my earlier as I press enter too fast.
I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another |
|
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
am not sure if this is exactly what you're seeking but it works on my
Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'określ czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 numer_pytania = Left(wiersz, j - 1) tekst_pytania = Right(wiersz, Len(wiersz) - j) pytanie = pytanie + 1 ActiveSheet.Cells(pytanie, 1) = numer_pytania ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text 'określ czy dany wiersz zawiera numer PODpytania For k = 1 To Len(wiersz) If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias tekst_PODpytania = Right(wiersz, Len(wiersz) - k) PODpytanie = PODpytanie + 1 ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania For l = 1 To Len(tekst_PODpytania & ")") If Mid(tekst_PODpytania & ")", l, 1) = ")" Then znajdz_kolejny_nawias = l Exit For End If Next l If k + Len(tekst_PODpytania) = Len(wiersz) Then ActiveSheet.Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Else Exit For End If End If Next k Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another |
|
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
Hi Jarek
Thanks. and yes, I do need them in english -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: am not sure if this is exactly what you're seeking but it works on my Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'określ czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 numer_pytania = Left(wiersz, j - 1) tekst_pytania = Right(wiersz, Len(wiersz) - j) pytanie = pytanie + 1 ActiveSheet.Cells(pytanie, 1) = numer_pytania ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text 'określ czy dany wiersz zawiera numer PODpytania For k = 1 To Len(wiersz) If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias tekst_PODpytania = Right(wiersz, Len(wiersz) - k) PODpytanie = PODpytanie + 1 ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania For l = 1 To Len(tekst_PODpytania & ")") If Mid(tekst_PODpytania & ")", l, 1) = ")" Then znajdz_kolejny_nawias = l Exit For End If Next l If k + Len(tekst_PODpytania) = Len(wiersz) Then ActiveSheet.Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Else Exit For End If End If Next k Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another |
|
#4
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
also you need to include a Microsoft Word 12.0 Object Library (or
lower) through Tools-Refereneces-Available references pls click YES if this helped Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim row_text As String Dim question_number As String Dim question_text As String Dim subquestion_number As String Dim subquestion_text As String Dim question As Integer Dim subquestion As Integer Dim find_next_bracket As Integer Dim this_doc As Word.Document On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Set this_doc = .ActiveDocument For i = 1 To 20 'this_doc.Paragraphs.Count subquestion = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = this_doc.Range(Start:=a, End:=a1) row_text = myrange.Text myrange.Select myrange.Copy 'determine whether a given row includes numeric question number For j = 1 To Len(row_text) If Mid(row_text, j, 1) = "." Then question = question + 1 question_number = Left(row_text, j - 1) question_text = Right(row_text, Len(row_text) - j) question = question + 1 ActiveSheet.Cells(question, 1) = question_number ActiveSheet.Cells(question, 2) = question_text 'go to the next paragraph a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = this_doc.Range(Start:=a, End:=a1) row_text = myrange.Text 'determine whether a given row includes subquestion (a), b), c) etc.) For k = 1 To Len(row_text) If Mid(row_text, k, 1) = ")" Then 'search for another bracket ")" subquestion_text = Right(row_text, Len(row_text) - k) subquestion = subquestion + 1 ActiveSheet.Cells(question, subquestion) = subquestion_text For l = 1 To Len(subquestion_text & ")") If Mid(subquestion_text & ")", l, 1) = ")" Then find_next_bracket = l Exit For End If Next l If k + Len(subquestion_text) = Len(row_text) Then ActiveSheet.Cells(question, subquestion) = Mid (subquestion_text, 1, find_next_bracket - 2) Else Exit For End If End If Next k Exit For End If Next j Next i End With this_doc.Close wrd.Quit Set wrd = Nothing End Sub On 24 Maj, 07:05, Francis wrote: Hi Jarek Thanks. and yes, I do need them in english -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: am not sure if this is exactly what you're seeking but it works on my Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ Â* Â* Â* Â* ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ Â* Â* Â* Â* PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ Â* Â* Â* Â* WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 Â* Â*'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'okreÅ›l czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 Â* Â* numer_pytania = Left(wiersz, j - 1) Â* Â* tekst_pytania = Right(wiersz, Len(wiersz) - j) Â* Â* pytanie = pytanie + 1 Â* Â* ActiveSheet.Cells(pytanie, 1) = numer_pytania Â* Â* ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text Â* Â* Â* Â* 'okreÅ›l czy dany wiersz zawiera numer PODpytania Â* Â* Â* Â* For k = 1 To Len(wiersz) Â* Â* Â* Â* If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias Â* Â* Â* Â* Â* Â* tekst_PODpytania = Right(wiersz, Len(wiersz) - k) Â* Â* Â* Â* Â* Â* PODpytanie = PODpytanie + 1 Â* Â* Â* Â* Â* Â* ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania Â* Â* Â* Â* Â* Â* For l = 1 To Len(tekst_PODpytania & ")") Â* Â* Â* Â* Â* Â* Â* Â* If Mid(tekst_PODpytania & ")", l, 1) = ")" Then Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* znajdz_kolejny_nawias = l Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* Â* Â* Next l Â* Â* Â* Â* Â* Â* If k + Len(tekst_PODpytania) = Len(wiersz) Then Â* Â* Â* Â* Â* Â* Â* Â* ActiveSheet.Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Â* Â* Â* Â* Â* Â* Else Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* End If Â* Â* Â* Â* Next k Â* Â* Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another- Ukryj cytowany tekst - - Pokaż cytowany tekst - |
|
#5
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
seems this macro works only in thisparticular case = when all a) b)
c)... are in the same paragraph On 24 Maj, 07:05, Francis wrote: Hi Jarek Thanks. and yes, I do need them in english -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: am not sure if this is exactly what you're seeking but it works on my Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ Â* Â* Â* Â* ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ Â* Â* Â* Â* PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ Â* Â* Â* Â* WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 Â* Â*'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'okreÅ›l czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 Â* Â* numer_pytania = Left(wiersz, j - 1) Â* Â* tekst_pytania = Right(wiersz, Len(wiersz) - j) Â* Â* pytanie = pytanie + 1 Â* Â* ActiveSheet.Cells(pytanie, 1) = numer_pytania Â* Â* ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text Â* Â* Â* Â* 'okreÅ›l czy dany wiersz zawiera numer PODpytania Â* Â* Â* Â* For k = 1 To Len(wiersz) Â* Â* Â* Â* If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias Â* Â* Â* Â* Â* Â* tekst_PODpytania = Right(wiersz, Len(wiersz) - k) Â* Â* Â* Â* Â* Â* PODpytanie = PODpytanie + 1 Â* Â* Â* Â* Â* Â* ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania Â* Â* Â* Â* Â* Â* For l = 1 To Len(tekst_PODpytania & ")") Â* Â* Â* Â* Â* Â* Â* Â* If Mid(tekst_PODpytania & ")", l, 1) = ")" Then Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* znajdz_kolejny_nawias = l Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* Â* Â* Next l Â* Â* Â* Â* Â* Â* If k + Len(tekst_PODpytania) = Len(wiersz) Then Â* Â* Â* Â* Â* Â* Â* Â* ActiveSheet.Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Â* Â* Â* Â* Â* Â* Else Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* End If Â* Â* Â* Â* Next k Â* Â* Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another- Ukryj cytowany tekst - - Pokaż cytowany tekst - |
|
#6
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
Hi Jarek
No problem, I can tweak the codes to suit my requirements -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: seems this macro works only in thisparticular case = when all a) b) c)... are in the same paragraph On 24 Maj, 07:05, Francis wrote: Hi Jarek Thanks. and yes, I do need them in english -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: am not sure if this is exactly what you're seeking but it works on my Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'określ czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 numer_pytania = Left(wiersz, j - 1) tekst_pytania = Right(wiersz, Len(wiersz) - j) pytanie = pytanie + 1 ActiveSheet.Cells(pytanie, 1) = numer_pytania ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text 'określ czy dany wiersz zawiera numer PODpytania For k = 1 To Len(wiersz) If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias tekst_PODpytania = Right(wiersz, Len(wiersz) - k) PODpytanie = PODpytanie + 1 ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania For l = 1 To Len(tekst_PODpytania & ")") If Mid(tekst_PODpytania & ")", l, 1) = ")" Then znajdz_kolejny_nawias = l Exit For End If Next l If k + Len(tekst_PODpytania) = Len(wiersz) Then ActiveSheet.Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Else Exit For End If End If Next k Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another- Ukryj cytowany tekst - - Pokaż cytowany tekst - |
|
#7
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Get Data from Word to Excel
it would be better to insert Exit For in the loop after the first dot
is found in "If Mid(wiersz, j, 1) = "." Then", cause a dot may also be in the end of a this same "numeric" paragraph thus causing some confusion On 24 Maj, 18:16, Francis wrote: Hi Jarek No problem, I can tweak the codes to suit my requirements -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: seems this macro works only in thisparticular case = when all a) b) c)... are in the same paragraph On 24 Maj, 07:05, Francis wrote: Hi Jarek Thanks. and yes, I do need them in english -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another "Jarek Kujawa" wrote: am not sure if this is exactly what you're seeking but it works on my Office 2007 surely it might be simpler but at the moment I cannot come up with anything better. let me know if you need variables and descriptions in English. -------- pls click YES if this helped -------- Sub cus() Dim wrd As Word.Application Dim myrange As Word.Range Dim wiersz As String Dim numer_pytania As String Dim tekst_pytania As String Dim numer_PODpytania As String Dim tekst_PODpytania As String Dim pytanie As Integer Dim PODpytanie As Integer On Error Resume Next ActiveSheet.UsedRange.Clear Set wrd = New Word.Application wrd.DisplayAlerts = wdAlertsNone With wrd ..Documents.Open Filename:="C:\Eksele\przyklad.docx", ConfirmConversions:=False, _ Â* Â* Â* Â* ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ Â* Â* Â* Â* PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ Â* Â* Â* Â* WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" Dim ten_dok As Word.Document Set ten_dok = .ActiveDocument For i = 1 To 20 Â* Â*'ten_dok.Paragraphs.Count PODpytanie = 2 a = .ActiveDocument.Paragraphs(i).Range.Start a1 = .ActiveDocument.Paragraphs(i).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text myrange.Select myrange.Copy 'okreÅ›l czy dany wiersz zawiera numer pytania For j = 1 To Len(wiersz) If Mid(wiersz, j, 1) = "." Then pytanie = pytanie + 1 Â* Â* numer_pytania = Left(wiersz, j - 1) Â* Â* tekst_pytania = Right(wiersz, Len(wiersz) - j) Â* Â* pytanie = pytanie + 1 Â* Â* ActiveSheet.Cells(pytanie, 1) = numer_pytania Â* Â* ActiveSheet.Cells(pytanie, 2) = tekst_pytania 'idziesz do kolejnego paragrafu a = .ActiveDocument.Paragraphs(i + 1).Range.Start a1 = .ActiveDocument.Paragraphs(i + 1).Range.End Set myrange = ten_dok.Range(Start:=a, End:=a1) wiersz = myrange.Text Â* Â* Â* Â* 'okreÅ›l czy dany wiersz zawiera numer PODpytania Â* Â* Â* Â* For k = 1 To Len(wiersz) Â* Â* Â* Â* If Mid(wiersz, k, 1) = ")" Then 'wyszukaj kolejny nawias Â* Â* Â* Â* Â* Â* tekst_PODpytania = Right(wiersz, Len(wiersz) - k) Â* Â* Â* Â* Â* Â* PODpytanie = PODpytanie + 1 Â* Â* Â* Â* Â* Â* ActiveSheet.Cells(pytanie, PODpytanie) = tekst_PODpytania Â* Â* Â* Â* Â* Â* For l = 1 To Len(tekst_PODpytania & ")") Â* Â* Â* Â* Â* Â* Â* Â* If Mid(tekst_PODpytania & ")", l, 1) = ")" Then Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* znajdz_kolejny_nawias = l Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* Â* Â* Next l Â* Â* Â* Â* Â* Â* If k + Len(tekst_PODpytania) = Len(wiersz) Then Â* Â* Â* Â* Â* Â* Â* Â* ActiveSheet..Cells(pytanie, PODpytanie) = Mid (tekst_PODpytania, 1, znajdz_kolejny_nawias - 2) Â* Â* Â* Â* Â* Â* Else Â* Â* Â* Â* Â* Â* Â* Â* Exit For Â* Â* Â* Â* Â* Â* End If Â* Â* Â* Â* End If Â* Â* Â* Â* Next k Â* Â* Exit For End If Next j Next i End With ten_dok.Close wrd.Quit Set wrd = Nothing End Sub On 23 Maj, 12:30, Francis wrote: Pls ignore my earlier as I press enter too fast. I have a Word document which contents shows as : 1.Apart from formal legal education, what alternative qualification is necessary for a legal assistant? a)a qualification in a related discipline b)there is no alternative c)many years of practical experience d)membership with a recognized association 2.Who supervises a legal assistants work? a)the Supreme Court b)the Managing Director c)a notary public d)an attorney e)no one How do I import these to give me : Col A = question number Col B = questions Col C = answer a) Col D = answer b) Col E = answer c) Col F = answer d) Col G = answer e) TIA -- Hope this is helpful Pls click the Yes button below if this post provide answer you have asked Thank You cheers, francis Am not a greek but an ordinary user trying to assist another- Ukryj cytowany tekst - - Pokaż cytowany tekst -- Ukryj cytowany tekst - - Pokaż cytowany tekst - |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Get data from Word into Excel | Excel Discussion (Misc queries) | |||
| Copy excel data (inc. textbox data) into Word | Excel Discussion (Misc queries) | |||
| Transfer Excel data into Word, including text box data | Excel Discussion (Misc queries) | |||
| I want to convert word column data to excel row data to sort addre | Excel Discussion (Misc queries) | |||
| Print labels by using Excel data in a Word mail into word | Excel Discussion (Misc queries) | |||
Linear Mode
