Good night.
I need 3 VBA in word.
First: to copy the title of heading X
Second: to copy between heading X to X+1
Third to go to the new heading
Ty
Good night.
I need 3 VBA in word.
First: to copy the title of heading X
Second: to copy between heading X to X+1
Third to go to the new heading
Ty
What is the point of the copying? Your outline says nothing about what you want to do with what you've copied.
Cheers
Paul Edstein
[Fmr MS MVP - Word]
Cross-posted at: https://www.msofficeforums.com/word-...t-heading.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
Cheers
Paul Edstein
[Fmr MS MVP - Word]
I need to transform my headings in a question and answer game in another software. So I would like to automate
For example
HeadStyle 1: Question 1: aaaaa?
Head Style 2: ans
Head Style 2: ans
Head Style 2: ans
HeadStyle 1: Question 2: bbbb?
Head Style 2: ans
Head Style 2: ans
no style text: ans
I want first to select current heading: "Question 1: aaaaa?" then copy --- after that I'll paste with autohotkey to another software.
Then, I would like to copy the answer:
Head Style 2: ans
Head Style 2: ans
no style text: ans
Then to repeat the process I would like to select next heading with headstyle 1: Question 2: bbbb?
Sorry for the double posting, my mistake
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Style = "Heading 1" While .Execute Do oRng.MoveEnd wdParagraph, 1 Loop Until oRng.Paragraphs.Last.Range.Style = "Heading 1" Or oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End oRng.MoveEnd wdParagraph, -1 oRng.Copy 'Do whatever with the complied content here. oRng.Collapse wdCollapseEnd Wend End With lbl_Exit: Exit Sub End Sub
Thanks man. But it did not work. It copied last paragraph, with the title with answer.
I'm tying one Sub to copy the title of X "heading 1", then another sub to copy everything is wrote in between X heading 1 and X+1 heading 1 except the title.
Example
My word:
"Style Heading 1" Question number 1:
wor
wor
"Style Heading 1" Question number 2
asn
asn
"Style Heading 1" Question number 3
asn
FunctionCopyTitle ( X=2) ..:
Clipboard Return: "Style Heading 1" Question number 2:
FunctionCopyAnswer ( X=2) ..:
Clipboard Return:
asn
asn
I have no idea what you are trying to do and your examples don't help. What is "wor". If you only want the content between the Heading 1 styles then:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Style = "Heading 1" While .Execute oRng.Move wdParagraph, 1 Do oRng.MoveEnd wdParagraph, 1 oRng.Select Loop Until oRng.Paragraphs.Last.Range.Style = "Heading 1" Or oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End If Not oRng.End = ActiveDocument.Range.End Then oRng.MoveEnd wdParagraph, -1 oRng.Copy MsgBox oRng.Text 'Do whatever with the complied content here. oRng.Collapse wdCollapseEnd Wend End With lbl_Exit: Exit Sub End Sub
Sub Selecionarperguntas()
Selection.MoveRight Unit:=wdWord, Count:=1
Application.ScreenUpdating = False
palavras = 0
Do Until Selection.Paragraphs(1).Style.NameLocal = "Título 1"
'Do Until ActiveDocument.Paragraphs(1).Style = "Título 1"
'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
Loop
palavras = 0
Do Until Selection.Words(1).Style.NameLocal <> "Título 1"
palavras = palavras + 1
Selection.MoveRight Unit:=wdWord, Count:=1
'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim
Loop
Selection.MoveLeft Unit:=wdWord, Count:=palavras, Extend:=wdExtend
If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim
Application.ScreenUpdating = True
Selection.Copy
fim:
Application.ScreenUpdating = True
End Sub
Sub Selecionarresposta()
Application.ScreenUpdating = False
palavras = 0
Do Until Selection.Words(1).Style.NameLocal <> "Título 1"
Selection.MoveRight Unit:=wdWord, Count:=1
'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim
Loop
Do Until Selection.Words(1).Style.NameLocal = "Título 1"
Selection.MoveRight Unit:=wdWord, Count:=1
'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim
palavras = palavras + 1
Loop
fim:
Selection.MoveLeft Unit:=wdWord, Count:=palavras, Extend:=wdExtend
Selection.Copy
Application.ScreenUpdating = True
End Sub
I did this macro, but sometimes it is too slow, anyway to improve?
nathanfsu: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
Cheers
Paul Edstein
[Fmr MS MVP - Word]
any help in how to improve the macro speed?Sub Selecionarperguntas() Selection.MoveRight Unit:=wdWord, Count:=1 Application.ScreenUpdating = False palavras = 0 Do Until Selection.Paragraphs(1).Style.NameLocal = "Título 1" 'Do Until ActiveDocument.Paragraphs(1).Style = "Título 1" 'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove Loop palavras = 0 Do Until Selection.Words(1).Style.NameLocal <> "Título 1" palavras = palavras + 1 Selection.MoveRight Unit:=wdWord, Count:=1 'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim Loop Selection.MoveLeft Unit:=wdWord, Count:=palavras, Extend:=wdExtend 'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim Application.ScreenUpdating = True Selection.Copy fim: Application.ScreenUpdating = True End Sub Sub Selecionarresposta() Application.ScreenUpdating = False palavras = 0 Do Until Selection.Words(1).Style.NameLocal <> "Título 1" Selection.MoveRight Unit:=wdWord, Count:=1 'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim Loop Do Until Selection.Words(1).Style.NameLocal = "Título 1" Selection.MoveRight Unit:=wdWord, Count:=1 'If Linha() >= ActiveDocument.Paragraphs.Count Then GoTo fim palavras = palavras + 1 Loop fim: Selection.MoveLeft Unit:=wdWord, Count:=palavras, Extend:=wdExtend Selection.Copy Application.ScreenUpdating = True End Sub
Simply wrapping code tags around unstructured code does nothing to improve its legibility...
Cheers
Paul Edstein
[Fmr MS MVP - Word]
You have been given plenty to work with yet you insist on coming back here with a mess of Selection code. For the process of selecting text between Heading 1, something like this (I still have no clue what you ultimately want to do. BTW, moving by words will always be slower than moving by paragraph unless of course the paragraphs have only one word.
Sub TextBetweenHeading1() 'A basic Word macro coded by Greg Maxey Dim oRng As Range Selection.Collapse wdCollapseEnd Set oRng = Selection.Range oRng.Collapse wdCollapseEnd Do While oRng.Paragraphs(1).Style = "Heading 1" oRng.Move wdParagraph, 1 Loop Do oRng.MoveEnd wdParagraph, 1 oRng.Select Loop Until oRng.Paragraphs.Last.Range.Style = "Heading 1" Or oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End If Not oRng.End = ActiveDocument.Range.End Then oRng.MoveEnd wdParagraph, -1 Do oRng.MoveStart wdParagraph, -1 oRng.Select Loop Until oRng.Paragraphs(1).Range.Style = "Heading 1" Or oRng.Paragraphs(1).Range.Start = ActiveDocument.Range.Start If Not oRng.Start = ActiveDocument.Range.Start Or oRng.Paragraphs(1).Style = "Heading 1" Then oRng.MoveStart wdParagraph, 1 oRng.Select oRng.Copy lbl_Exit: Exit Sub End Sub
Also cross-posted at: https://stackoverflow.com/questions/...gs-in-word-vba
Since you've ignored this forum's cross-posting rules, by failing to provide the required link, I am closing this thread.
Cheers
Paul Edstein
[Fmr MS MVP - Word]