wdg1
08-09-2023, 07:29 AM
Hello.
In a Word document, I have 10 paragraphs with text (page 5 to 10).
For instance:
par 1: clinical examination of the neck,
par 2: clinical examination of the shoulder,
par 3: clinical examination of the wrist,
par 4: clinical examination of the hip,
par 5: clinical examination of the knee
Now, I want to preserve 1 par.
Example 1: I want to keep "shoulder".
So, "neck", "wrist", "hip", "knee" must be deleted.
To build the macro, I putted some extra words in my document:
.... clinical examination:
<11301> Neck: what I see, what I examin, end so on...
<11302> Shoulder: what I see, what I examin, end so on...
<11303> Wrist: what I see, what I examin, end so on...
<11304> Hip: what I see, what I examin, end so on...
<11305> Knee: what I see, what I examin, end so on...
<11306>
How do I make a appropiate VBA code?
How to pass a word variable to another macro?
ByRef and ByVal does not work.
This is what I made, so far:
________
Dim StartWord1 As String, EndWord1 As String, StartWord2 As String, EndWord2 As String
Dim Action0 As String '
Dim AskBox1 As String
Dim Find1stRange1 As Range, FindEndRange1 As Range
Dim DelRange1 As Range, DelStartRange1 As Range, DelEndRange1 As Range
Dim Find1stRange2 As Range, FindEndRange2 As Range
Dim DelRange2 As Range, DelStartRange2 As Range, DelEndRange2 As Range
Dim answer As Integer
Set Find1stRange2 = ActiveDocument.Range
Set FindEndRange2 = ActiveDocument.Range
Set DelRange2 = ActiveDocument.Range
Set DelEndRange2 = ActiveDocument.Range
Askbox1 = "1 Neck" & vbNewLine & _
"2 shouder" & vbNewLine & _
"3 wrist" & vbNewLine & _
"4 hip" & vbNewLine & _
"5 knee" & vbNewLine & _
Action0 = InputBox(Macaron1, "Keuze menu")
If Action0 = "" Then Exit Sub
If Action0 = "1" Then
' Neck is chosen
' Delete "<11301>"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<11301>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
' Delete <11302> to <11306>
StartWord2 = "<11302>"
EndWord2 = "<11306>"
Call deletesection2
ElseIf Action0 = "2" Then
' shoulder is chosen
' delete <11301> to <11302>, , and del also "<11303>"
' delete <11303> to <11306>, , and del also "<11306>"
StartWord1 = "<11301>"
EndWord1 = "<11302>"
StartWord2 = "<11303>"
EndWord2 = "<11801>"
Call deletesection1
Call deletesection2
ElseIf Action0 = "3" Then
' wrist is chosen
' delete <11301> to <11303>, and del also "<11303>"
' delete <11304> to <11306>, and del also "<11306>"
StartWord1 = "<11301>"
EndWord1 = "<11303>"
StartWord2 = "<11304>"
EndWord2 = "<11806>"
Call DeleteSection1(StartWord1, EndWord1, Find1stRange1, FindEndRange1, DelRange1, DelStartRange1, DelEndRange1)
' Call deletesection2
' --------
' so far, so good.
' Now the macro for delete section 1
' _____________
Sub DeleteSection1(ByRef Find1stRange1 As Range, ByRef FindEndRange1 As Range, ByRef DelRange1 As Range, ByRef DelStartRange1 As Range, ByRef DelEndRange1 As Range, ByVal StartWord1 As String, ByVal EndWord1 As String)
Set Find1stRange1 = ActiveDocument.Range
Set FindEndRange1 = ActiveDocument.Range
Set DelRange1 = ActiveDocument.Range
Set DelEndRange1 = ActiveDocument.Range
With Find1stRange1.Find
.Text = StartWord1
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
If .Found = True Then
Set DelStartRange1 = Find1stRange1
DelStartRange1.Select
FindEndRange1.Start = DelStartRange1.End
FindEndRange1.End = ActiveDocument.Content.End
FindEndRange1.Select
With FindEndRange1.Find
.Text = EndWord1
.Execute
If .Found = True Then
Set DelEndRange1 = FindEndRange1
DelEndRange1.Select
End If
End With
DelRange1.Start = DelStartRange1.Start
DelRange1.End = DelEndRange1.End
DelRange1.Select
DelRange1.Delete
End If
Loop
End With
End Sub
In a Word document, I have 10 paragraphs with text (page 5 to 10).
For instance:
par 1: clinical examination of the neck,
par 2: clinical examination of the shoulder,
par 3: clinical examination of the wrist,
par 4: clinical examination of the hip,
par 5: clinical examination of the knee
Now, I want to preserve 1 par.
Example 1: I want to keep "shoulder".
So, "neck", "wrist", "hip", "knee" must be deleted.
To build the macro, I putted some extra words in my document:
.... clinical examination:
<11301> Neck: what I see, what I examin, end so on...
<11302> Shoulder: what I see, what I examin, end so on...
<11303> Wrist: what I see, what I examin, end so on...
<11304> Hip: what I see, what I examin, end so on...
<11305> Knee: what I see, what I examin, end so on...
<11306>
How do I make a appropiate VBA code?
How to pass a word variable to another macro?
ByRef and ByVal does not work.
This is what I made, so far:
________
Dim StartWord1 As String, EndWord1 As String, StartWord2 As String, EndWord2 As String
Dim Action0 As String '
Dim AskBox1 As String
Dim Find1stRange1 As Range, FindEndRange1 As Range
Dim DelRange1 As Range, DelStartRange1 As Range, DelEndRange1 As Range
Dim Find1stRange2 As Range, FindEndRange2 As Range
Dim DelRange2 As Range, DelStartRange2 As Range, DelEndRange2 As Range
Dim answer As Integer
Set Find1stRange2 = ActiveDocument.Range
Set FindEndRange2 = ActiveDocument.Range
Set DelRange2 = ActiveDocument.Range
Set DelEndRange2 = ActiveDocument.Range
Askbox1 = "1 Neck" & vbNewLine & _
"2 shouder" & vbNewLine & _
"3 wrist" & vbNewLine & _
"4 hip" & vbNewLine & _
"5 knee" & vbNewLine & _
Action0 = InputBox(Macaron1, "Keuze menu")
If Action0 = "" Then Exit Sub
If Action0 = "1" Then
' Neck is chosen
' Delete "<11301>"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<11301>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
' Delete <11302> to <11306>
StartWord2 = "<11302>"
EndWord2 = "<11306>"
Call deletesection2
ElseIf Action0 = "2" Then
' shoulder is chosen
' delete <11301> to <11302>, , and del also "<11303>"
' delete <11303> to <11306>, , and del also "<11306>"
StartWord1 = "<11301>"
EndWord1 = "<11302>"
StartWord2 = "<11303>"
EndWord2 = "<11801>"
Call deletesection1
Call deletesection2
ElseIf Action0 = "3" Then
' wrist is chosen
' delete <11301> to <11303>, and del also "<11303>"
' delete <11304> to <11306>, and del also "<11306>"
StartWord1 = "<11301>"
EndWord1 = "<11303>"
StartWord2 = "<11304>"
EndWord2 = "<11806>"
Call DeleteSection1(StartWord1, EndWord1, Find1stRange1, FindEndRange1, DelRange1, DelStartRange1, DelEndRange1)
' Call deletesection2
' --------
' so far, so good.
' Now the macro for delete section 1
' _____________
Sub DeleteSection1(ByRef Find1stRange1 As Range, ByRef FindEndRange1 As Range, ByRef DelRange1 As Range, ByRef DelStartRange1 As Range, ByRef DelEndRange1 As Range, ByVal StartWord1 As String, ByVal EndWord1 As String)
Set Find1stRange1 = ActiveDocument.Range
Set FindEndRange1 = ActiveDocument.Range
Set DelRange1 = ActiveDocument.Range
Set DelEndRange1 = ActiveDocument.Range
With Find1stRange1.Find
.Text = StartWord1
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
If .Found = True Then
Set DelStartRange1 = Find1stRange1
DelStartRange1.Select
FindEndRange1.Start = DelStartRange1.End
FindEndRange1.End = ActiveDocument.Content.End
FindEndRange1.Select
With FindEndRange1.Find
.Text = EndWord1
.Execute
If .Found = True Then
Set DelEndRange1 = FindEndRange1
DelEndRange1.Select
End If
End With
DelRange1.Start = DelStartRange1.Start
DelRange1.End = DelEndRange1.End
DelRange1.Select
DelRange1.Delete
End If
Loop
End With
End Sub