4,375 questions
Excel VBA: Replace/convert date fields in header and footer to sample text
RHub102
1
Reputation point
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
3,888 questions
Developer technologies Visual Basic for Applications
1,508 questions
Sign in to answer