Update:---------------------------------------------------------





Sub Schriftliste_sortiert()

   Dim Schrift As Variant

   Application.ScreenUpdating = False

   Documents.Add Template:="normal"



   For Each Schrift In FontNames

      With Selection

         .Font.Name = "times new roman"

         .Font.Bold = True

         .Font.Underline = True

         .TypeText Schrift

         .TypeText Chr(11)

         .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove

         .Font.Bold = False

         .Font.Underline = False

         .Font.Name = Schrift

         .TypeText "abcdefghijklmnopqrstuvwxyz-äöüß"

         .TypeText Chr(11)

         .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove

         .TypeText "0123456789?$%&()[]*_-=+/<>"

         .TypeText Chr(11)

         .InsertParagraphAfter

         .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove

      End With



   Next Schrift

   

   Selection.WholeStory

   Selection.Sort ExcludeHeader:=False, FieldNumber:="Absätze", SortFieldType _

        :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending

   Selection.MoveUp Unit:=wdLine, Count:=1

   

   Application.ScreenUpdating = True

End Sub







Tipp 2: --------------------------------------------------------



[Shell]

Command=2

IconFile=explorer.exe,3

[Taskbar]

Command=ToggleDesktop







Tipp 7: --------------------------------------------------------





Option Explicit



Dim listArgs

Dim objFileSystem, objFolder, objFile

Dim szFolder, szDateCreated, szYear, szMonth, szDay



Set listArgs = WScript.Arguments



If listArgs.Count = 0 Then

   szFolder = InputBox("Welcher Ordner?","Ordner auswählen","C:\Daten\Alex\Fotos")

Else

   szFolder = listArgs(0)

End If



Set objFileSystem = CreateObject("Scripting.FileSystemObject")



If objFileSystem.FolderExists(szFolder) Then



   Set objFolder = objFileSystem.GetFolder(szFolder)

   

   For Each objFile In objFolder.Files

      If objFile.Type = "JPEG-Bild" Then

         

         szDateCreated = objFile.DateCreated

         szYear = Year(szDateCreated)

         szMonth = Month(szDateCreated)

         szDay = Day(szDateCreated)

         

         If isDate(szDateCreated) Then

            

            szYear = Year(szDateCreated)

            szMonth = Month(szDateCreated)

            szDay = Day(szDateCreated)

            

            If szMonth < 10 Then

               szMonth = "0" & szMonth

            End If



            If szDay < 10 Then

               szDay = "0" & szDay

            End If

            

            szDateCreated = szYear & szMonth & szDay

            

            If szDateCreated <> left(objFile.Name, 8) Then

               objFile.Name = szDateCreated & " " & objFile.Name

            End If   

            

         End If

      End If

   Next 



Else

   MsgBox "Angegebener Ordner existiert nicht!"

End If







Tipp 16: --------------------------------------------------------



Private Sub Application_NewMail()



Const constFolder = "C:\Daten\Wochenberichte"

Const constSubject = "Wochenbericht"



On Error Resume Next



Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)



For Each objNewMail In objInbox.Items

    If objNewMail.UnRead = True Then

        If objNewMail.Subject = constSubject Then

            intAttachments = objNewMail.Attachments.Count

            If intAttachments > 0 Then

                For intCounter = 1 To intAttachments

                    objNewMail.Attachments.Item(intCounter).SaveAsFile constFolder & "\" & objNewMail.Attachments.Item(intCounter).FileName

                    MsgBox objNewMail.Attachments.Item(intCounter).FileName & " in " & constFolder & " gespeichert!"

                Next

            End If

        End If

    End If

Next objNewMail

End Sub







Tipp 21: ----------------------------------------------------------------------------



Sub Ferien()

Sheets("InfoBlatt").Range("A5").Copy

ActiveSheet.Paste

Application.CutCopyMode = False

End Sub







Tipp 22: -------------------------------------------------



ActiveSheet.Unprotect Password:="abc"



ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="abc"