Sub Klargør_MUD_til_Harris_V2()

Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "*Anlægsbeskrivelse??Kampagne: ??-??-??????"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Dim n As Long
    
    With ActiveDocument
        For n = 2 To .Paragraphs.Count Step 7
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    With ActiveDocument
        For n = 3 To .Paragraphs.Count Step 6
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    With ActiveDocument
        For n = 3 To .Paragraphs.Count Step 5
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    With ActiveDocument
        For n = 3 To .Paragraphs.Count Step 4
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    With ActiveDocument
        For n = 3 To .Paragraphs.Count Step 3
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    With ActiveDocument
        For n = 3 To .Paragraphs.Count Step 2
            'Der slettes løbende afnit - stop når enden af dokument er overskredet
            If n > .Paragraphs.Count Then Exit For
            .Paragraphs(n).Range.Delete
        Next n
    End With
    
    
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Beskrivelse:*Anlæg over #:"
        .Replacement.Text = "            above:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "# samtidig med:"
        .Replacement.Text = "^p            contemporary with:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "# samme som:"
        .Replacement.Text = "^p            equal to:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Anlæg under #:"
        .Replacement.Text = "^p            below:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.TypeText Text:= _
     "               Stratigraphic Dataset StratyTest" & vbCrLf & vbCrLf & "  Name" & vbPag
    Selection.TypeParagraph
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^m^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    ChangeFileOpenDirectory "C:\MUDtilMI\FraMUD\"
    ActiveDocument.SaveAs FileName:="MatrixFraMUD.lst", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
        , LineEnding:=wdCRLF
End Sub

Sub Klargør_MUD_til_MI_V2()
'
' Klargøring_af_MUD_tabeller Makro
' Makro indspillet 03/12/2009 af bruger
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "*Anlægsbeskrivelse??Kampagne: ??-??-??????"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.Replacement.ClearFormatting
    
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "---"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "---"
        .Replacement.Text = "^t" + Left$(FileName, 7) + "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Beskrivelse:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Dybde i cm:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Nuance:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    With Selection.Find
        .Text = "Diameter i cm:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Side:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Bund:"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Tegninger:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Foto:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Består:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   With Selection.Find
        .Text = "Fund:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
   
     Selection.TypeText Text:= _
     "Anr" & vbTab & "Hovedgruppe" & vbTab & "Undergruppe" & vbTab & "Datering" & vbTab & "Diameter" & vbTab & "Dybde" & vbTab & "Side" & vbTab & "Bund" & vbTab & "Nuance" & vbTab & "Beskrivelse" & vbTab & "Tegning" & vbTab & "Foto" & vbTab & "Består af" & vbTab & "Fund" & vbPag
    Selection.TypeParagraph
    
    Selection.WholeStory

Dim n As Long
    Set myRange = ActiveDocument.Content
    Dim oRange As Range
    
    'Definer i hvilke afsnit udskiftning skal foretages
    'her er som eksempel brugt afsnittene i markeringen
    Set oRange = Selection.Range
    
    For n = 1 To oRange.Paragraphs.Count
        With oRange.Paragraphs(n)
            'Fjern de første 2 forekomster af ", "
            .Range.Text = Replace(Expression:=.Range.Text, Find:=", ", Replace:=vbTab, Start:=1, Count:=2)
        End With
    Next n
  
    'Ryd op
    Set oRange = Nothing

ChangeFileOpenDirectory "C:\MUDtilMI\FraMUD\"
    ActiveDocument.SaveAs FileName:="TekstFraMUD.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
        , LineEnding:=wdCRLF
End Sub
