Sub export()
 
 
If strKat = "" Then 
    strKat = "Reisebericht"
End If
 
strUser = GetUserName()'Fkt zum ermitteln des User Namens
 
'markieren und kopieren
 Selection.WholeStory
 Selection.Copy
 
'neues Dokument
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
 
        With ActiveDocument.Styles(wdStyleNormal).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(2.5)
        .BottomMargin = CentimetersToPoints(2.5)
        .LeftMargin = CentimetersToPoints(2)
        .RightMargin = CentimetersToPoints(2.5)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.25)
        .FooterDistance = CentimetersToPoints(1.25)
        .PageWidth = CentimetersToPoints(29.7)
        .PageHeight = CentimetersToPoints(21)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
 
'einfügen    
    Selection.PasteAndFormat (wdPasteDefault)
 
'Ordner wählen
    ChangeFileOpenDirectory "C:\Dokumente und Einstellungen\" & strUser & _
      "\Desktop\"
    ActiveDocument.SaveAs FileName:=strKat & ".doc", _
    FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, _
        WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:= _
        False
strExEm = ActiveDocument.FullName
ActiveDocument.Close
Selection.MoveLeft Unit:=wdCharacter, Count:=1
 
'Documents.Close
End Sub