home *** CD-ROM | disk | FTP | other *** search
/ Chip: 25 Years Anniversary / CHIP_25Jahre_Jubilaeum.iso / downloads / 401202 / Listings11.txt
Text File  |  2003-09-09  |  4KB  |  154 lines
  1. Update:---------------------------------------------------------
  2.  
  3.  
  4. Sub Schriftliste_sortiert()
  5.    Dim Schrift As Variant
  6.    Application.ScreenUpdating = False
  7.    Documents.Add Template:="normal"
  8.  
  9.    For Each Schrift In FontNames
  10.       With Selection
  11.          .Font.Name = "times new roman"
  12.          .Font.Bold = True
  13.          .Font.Underline = True
  14.          .TypeText Schrift
  15.          .TypeText Chr(11)
  16.          .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
  17.          .Font.Bold = False
  18.          .Font.Underline = False
  19.          .Font.Name = Schrift
  20.          .TypeText "abcdefghijklmnopqrstuvwxyz-Σ÷ⁿ▀"
  21.          .TypeText Chr(11)
  22.          .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
  23.          .TypeText "0123456789?$%&()[]*_-=+/<>"
  24.          .TypeText Chr(11)
  25.          .InsertParagraphAfter
  26.          .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
  27.       End With
  28.  
  29.    Next Schrift
  30.    
  31.    Selection.WholeStory
  32.    Selection.Sort ExcludeHeader:=False, FieldNumber:="AbsΣtze", SortFieldType _
  33.         :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
  34.    Selection.MoveUp Unit:=wdLine, Count:=1
  35.    
  36.    Application.ScreenUpdating = True
  37. End Sub
  38.  
  39.  
  40.  
  41. Tipp 2: --------------------------------------------------------
  42.  
  43. [Shell]
  44. Command=2
  45. IconFile=explorer.exe,3
  46. [Taskbar]
  47. Command=ToggleDesktop
  48.  
  49.  
  50.  
  51. Tipp 7: --------------------------------------------------------
  52.  
  53.  
  54. Option Explicit
  55.  
  56. Dim listArgs
  57. Dim objFileSystem, objFolder, objFile
  58. Dim szFolder, szDateCreated, szYear, szMonth, szDay
  59.  
  60. Set listArgs = WScript.Arguments
  61.  
  62. If listArgs.Count = 0 Then
  63.    szFolder = InputBox("Welcher Ordner?","Ordner auswΣhlen","C:\Daten\Alex\Fotos")
  64. Else
  65.    szFolder = listArgs(0)
  66. End If
  67.  
  68. Set objFileSystem = CreateObject("Scripting.FileSystemObject")
  69.  
  70. If objFileSystem.FolderExists(szFolder) Then
  71.  
  72.    Set objFolder = objFileSystem.GetFolder(szFolder)
  73.    
  74.    For Each objFile In objFolder.Files
  75.       If objFile.Type = "JPEG-Bild" Then
  76.          
  77.          szDateCreated = objFile.DateCreated
  78.          szYear = Year(szDateCreated)
  79.          szMonth = Month(szDateCreated)
  80.          szDay = Day(szDateCreated)
  81.          
  82.          If isDate(szDateCreated) Then
  83.             
  84.             szYear = Year(szDateCreated)
  85.             szMonth = Month(szDateCreated)
  86.             szDay = Day(szDateCreated)
  87.             
  88.             If szMonth < 10 Then
  89.                szMonth = "0" & szMonth
  90.             End If
  91.  
  92.             If szDay < 10 Then
  93.                szDay = "0" & szDay
  94.             End If
  95.             
  96.             szDateCreated = szYear & szMonth & szDay
  97.             
  98.             If szDateCreated <> left(objFile.Name, 8) Then
  99.                objFile.Name = szDateCreated & " " & objFile.Name
  100.             End If   
  101.             
  102.          End If
  103.       End If
  104.    Next 
  105.  
  106. Else
  107.    MsgBox "Angegebener Ordner existiert nicht!"
  108. End If
  109.  
  110.  
  111.  
  112. Tipp 16: --------------------------------------------------------
  113.  
  114. Private Sub Application_NewMail()
  115.  
  116. Const constFolder = "C:\Daten\Wochenberichte"
  117. Const constSubject = "Wochenbericht"
  118.  
  119. On Error Resume Next
  120.  
  121. Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  122.  
  123. For Each objNewMail In objInbox.Items
  124.     If objNewMail.UnRead = True Then
  125.         If objNewMail.Subject = constSubject Then
  126.             intAttachments = objNewMail.Attachments.Count
  127.             If intAttachments > 0 Then
  128.                 For intCounter = 1 To intAttachments
  129.                     objNewMail.Attachments.Item(intCounter).SaveAsFile constFolder & "\" & objNewMail.Attachments.Item(intCounter).FileName
  130.                     MsgBox objNewMail.Attachments.Item(intCounter).FileName & " in " & constFolder & " gespeichert!"
  131.                 Next
  132.             End If
  133.         End If
  134.     End If
  135. Next objNewMail
  136. End Sub
  137.  
  138.  
  139.  
  140. Tipp 21: ----------------------------------------------------------------------------
  141.  
  142. Sub Ferien()
  143. Sheets("InfoBlatt").Range("A5").Copy
  144. ActiveSheet.Paste
  145. Application.CutCopyMode = False
  146. End Sub
  147.  
  148.  
  149.  
  150. Tipp 22: -------------------------------------------------
  151.  
  152. ActiveSheet.Unprotect Password:="abc"
  153.  
  154. ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="abc"