Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-16-2018, 05:41 AM
Lady_Laughsalot Lady_Laughsalot is offline VBA code to convert Heading 1, 2, 3 etc. numbering Windows 10 VBA code to convert Heading 1, 2, 3 etc. numbering Office 2016
Novice
VBA code to convert Heading 1, 2, 3 etc. numbering
 
Join Date: Apr 2018
Posts: 3
Lady_Laughsalot is on a distinguished road
Default VBA code to convert Heading 1, 2, 3 etc. numbering

Hi, I am trying to write code to firstly convert auto numbering to manual then convert the Heading 1, 2, 3 numbering to Schedule Level numbering. I've got the code to work but at the moment it is converting all auto numbering to manual. How can I get the first bit of the code to only convert the Heading 1, 2 numbering to manual and leave everything else as it is. The code works to insert Schedule Level numbering as auto but it leaves in the manual number after the auto numbering - is there a way I can remove the manual number also. If you run the code on the attached document you will see what I mean.



Many thanks in advance of help. Shelley

Code:
Sub DPU_ConvertToScheduleNum()
   ActiveDocument.Range.ListFormat.ConvertNumbersToText
    Selection.Find.Style = ActiveDocument.Styles("Heading 1")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 1")
    With Selection.Find
        .Text = "[0-9.]@^t"
        .Replacement.Text = ""
           End With
    Selection.Find.Execute Replace:=wdReplaceAll
      Selection.Find.Style = ActiveDocument.Styles("Heading 2")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 2")
    With Selection.Find
        .Text = "[0-9.0-9]@^t"
        .Replacement.Text = ""
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Style = ActiveDocument.Styles("Heading 3")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 3")
    With Selection.Find
        .Text = "[0-9.0-9.0-9]@^t"
        .Replacement.Text = ""
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
   Selection.Find.Style = ActiveDocument.Styles("Heading 4")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 4")
    With Selection.Find
        .Text = "[0-9.0-9.0-9.0-9.0-9]@^t"
        .Replacement.Text = ""
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.Style = ActiveDocument.Styles("Heading 5")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 5")
    With Selection.Find
        .Text = "[\(][a-z][\)]^t"
        .Replacement.Text = ""
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
         Selection.Find.Style = ActiveDocument.Styles("Heading 6")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 6")
    With Selection.Find
        .Text = "[\(][a-z][\)]^t"
        .Replacement.Text = ""
         End With
    Selection.Find.Execute Replace:=wdReplaceAll
     Selection.Find.Style = ActiveDocument.Styles("Heading 7")
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
        "Schedule Level 7")
    With Selection.Find
        .Text = "[\(][A-Z][\)]^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
     End With
   Selection.Find.Execute Replace:=wdReplaceAll
 
End Sub
Attached Files
File Type: docx Test Heading Num to Schedule Num.docx (30.2 KB, 23 views)
Reply With Quote
  #2  
Old 04-16-2018, 03:17 PM
macropod's Avatar
macropod macropod is offline VBA code to convert Heading 1, 2, 3 etc. numbering Windows 7 64bit VBA code to convert Heading 1, 2, 3 etc. numbering Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

It seems to me that all you need is:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  For i = 1 To 4
    .Style = "Heading " & i
    .Replacement.Style = "Schedule Level " & i
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 04-17-2018, 12:42 AM
Lady_Laughsalot Lady_Laughsalot is offline VBA code to convert Heading 1, 2, 3 etc. numbering Windows 10 VBA code to convert Heading 1, 2, 3 etc. numbering Office 2016
Novice
VBA code to convert Heading 1, 2, 3 etc. numbering
 
Join Date: Apr 2018
Posts: 3
Lady_Laughsalot is on a distinguished road
Default

Hi Macropod
Thanks for this - I've run the code but it has a compile error variable not defined message and the word .Replacement was highlighted - any ideas?
Thanks, Shelley

Quote:
Originally Posted by macropod View Post
It seems to me that all you need is:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  For i = 1 To 4
    .Style = "Heading " & i
    .Replacement.Style = "Schedule Level " & i
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub
Reply With Quote
  #4  
Old 04-17-2018, 03:01 PM
macropod's Avatar
macropod macropod is offline VBA code to convert Heading 1, 2, 3 etc. numbering Windows 7 64bit VBA code to convert Heading 1, 2, 3 etc. numbering Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The code runs fine for me - on your attachment. Try re-starting Word.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 04-18-2018, 12:32 AM
Lady_Laughsalot Lady_Laughsalot is offline VBA code to convert Heading 1, 2, 3 etc. numbering Windows 10 VBA code to convert Heading 1, 2, 3 etc. numbering Office 2016
Novice
VBA code to convert Heading 1, 2, 3 etc. numbering
 
Join Date: Apr 2018
Posts: 3
Lady_Laughsalot is on a distinguished road
Default

Hi Macropod, many thanks for the tip it seems Word was playing up for me yesterday and its worked today. Thank you. Best wishes, Shelley


Quote:
Originally Posted by macropod View Post
The code runs fine for me - on your attachment. Try re-starting Word.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Heading not following the correct numbering jongleur Word 2 05-16-2017 10:52 AM
Fixing my heading numbering tomsrv Word 3 08-31-2016 12:17 AM
Unhidden Heading Numbering snmuvz Word 5 02-04-2015 08:01 PM
Heading 3 numbering not working right Dr Wu Word 2 04-02-2013 07:24 AM
VBA code to convert Heading 1, 2, 3 etc. numbering Heading numbering anomaly Ulodesk Word 8 03-19-2012 01:57 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:11 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft