Excel VBA: Replace/convert date fields in header and footer to sample text

RHub102 1 Reputation point
2022-05-31T05:34:09.247+00:00

I need an excel macro to replace all date fields in the header and footer to a sample text like "here was a date" and unlink all other fields. I have a solution already for Word but I don't know how to do it in Excel. This word macro will unlink all fields and search for date and time fields and replace it with a sample text.

Thank you for the help!

Here is my macro for Word:

Sub AutoOpen()  
  
    Dim oField As Field, bErrMark As Boolean, strPrompt As String, bFieldCodeHidden As Boolean  
    Dim oStory As Range  
    Const strREPLACETEXT = "{TIME\@dd.MMMM.yyyy}" ' Text für die Ersetzung  
      
    On Error GoTo OOPS  
    Let bFieldCodeHidden = ActiveWindow.View.ShowFieldCodes  
    Let ActiveWindow.View.ShowFieldCodes = True  
  
    For Each oStory In ActiveDocument.StoryRanges  
        With oStory.Find  
            .ClearFormatting  
            .Replacement.ClearFormatting  
            .Text = "^d Date"  
            .Replacement.Text = strREPLACETEXT  
            .Execute Replace:=wdReplaceAll  
            .Text = "^d Time"  
            .Execute Replace:=wdReplaceAll  
        End With  
    Next oStory  
      
    Let strPrompt = "Alle Felder wurden mit dem folgenden Wert ersetzt. " & strREPLACETEXT  
    GoTo ResumeMacro  
  
OOPS:  
    Let strPrompt = "Es gab ein Problem bei der Verarbeitung des Makros."  
      
ResumeMacro:  
      
    With ActiveDocument.Range.Find  
        .ClearFormatting  
        .Text = ""  
        .Replacement.ClearFormatting  
        .Replacement.Text = ""  
    End With  
    Application.ScreenUpdating = True  
    Application.ScreenRefresh  
    Set oField = Nothing  
  
    Set oStory = Nothing  
    Let ActiveWindow.View.ShowFieldCodes = bFieldCodeHidden  
    On Error GoTo -1  
  
With ActiveDocument  
    If .ProtectionType = wdAllowOnlyRevisions Then  
        .Unprotect  
    End If  
    .TrackRevisions = False  
    .ShowRevisions = False  
End With  
  
ActiveDocument.Fields.Unlink  
  
Dim oSection As Section  
Dim oHeader As HeaderFooter  
Dim oFooter As HeaderFooter  
  
For Each oSection In ActiveDocument.Sections  
  
    For Each oHeader In oSection.Headers  
        If oHeader.Exists Then  
            For Each oField In oHeader.Range.Fields  
              
            'Überprüfen ob Seitennummer  
            If oField.Type = wdFieldPage Then  
            Else  
            oField.Unlink  
            End If  
              
            Next oField  
        End If  
    Next oHeader  
  
    For Each oFooter In oSection.Footers  
        If oFooter.Exists Then  
             For Each oField In oFooter.Range.Fields  
               
            'Überprüfen ob Seitennummer  
            If oField.Type = wdFieldPage Then  
            Else  
            oField.Unlink  
            End If  
  
            Next oField  
        End If  
    Next oFooter  
Next oSection  
  
ActiveDocument.Save  
ActiveDocument.Close  
Application.Quit  
  
End Sub  


  
Microsoft 365 and Office Development Other
Microsoft 365 and Office Excel For business Windows
Developer technologies Visual Basic for Applications
0 comments No comments
{count} votes

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.