Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
VBA-Beispiele mit Datei
Gehe zu Seite Zurück  1, 2, 3  Weiter
zurück: Gesamten Text aus Word.doc nach Excel kopieren weiter: Bedeutung der Befehle wie dim, while, wend etc. Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
03. Aug 2010, 10:29
Rufname:

Combobox in Userform sortieren - Combobox in Userform sortieren

Nach oben
       

Code:
    Dim i       As Long
    Dim j       As Long
    Dim k       As Long
    Dim aBuf   
   
    With Userformname.ComboBox1
        k = .ListCount
        For j = 0 To k - 1
            For i = (j + 1) To (k - 1)
                If .List(i) < .List(j) Then
                    aBuf = .List(j)
                    .List(j) = .List(i)
                    .List(i) = aBuf
                End If
            Next i
        Next j
    End With
Funktioniert auch mit der Listbox.
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
03. Aug 2010, 10:41
Rufname:


Username auslesen - Username auslesen

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_ComputerSystem", , 48)
    For Each objItem In colItems
        MsgBox "UserName: " & objItem.username
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
03. Aug 2010, 10:45
Rufname:

Betriebssystem auslesen - Betriebssystem auslesen

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_OperatingSystem", , 48)
    For Each objItem In colItems
        MsgBox "Caption: " & objItem.Caption
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
03. Aug 2010, 10:46
Rufname:

Installierte Drucker listen - Installierte Drucker listen

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_Printer", , 48)
    For Each objItem In colItems
        MsgBox "Caption: " & objItem.Caption
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:18
Rufname:


Überprüfung, ob CD/DVD eingelegt ist - Überprüfung, ob CD/DVD eingelegt ist

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_CDROMDrive", , 48)
    For Each objItem In colItems
        MsgBox "MediaLoaded: " & objItem.MediaLoaded
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:23
Rufname:

Festplattendaten auslesen - Festplattendaten auslesen

Nach oben
       

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."     
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive", , 48)
    For Each objItem In colItems
        MsgBox "-----------------------------------"
        MsgBox "Win32_DiskDrive instance"
        MsgBox "-----------------------------------"
        MsgBox "Availability: " & objItem.Availability
        MsgBox "BytesPerSector: " & objItem.BytesPerSector
        If IsNull(objItem.Capabilities) Then
            MsgBox "Capabilities: "
          Else
            MsgBox "Capabilities: " & Join(objItem.Capabilities, ",")
        End If
        If IsNull(objItem.CapabilityDescriptions) Then
            MsgBox "CapabilityDescriptions: "
          Else
            MsgBox "CapabilityDescriptions: " & Join(objItem.CapabilityDescriptions, ",")
        End If
        MsgBox "Caption: " & objItem.Caption
        MsgBox "CompressionMethod: " & objItem.CompressionMethod
        MsgBox "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
        MsgBox "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
        MsgBox "CreationClassName: " & objItem.CreationClassName
        MsgBox "DefaultBlockSize: " & objItem.DefaultBlockSize
        MsgBox "Description: " & objItem.Description
        MsgBox "DeviceID: " & objItem.DeviceID
        MsgBox "ErrorCleared: " & objItem.ErrorCleared
        MsgBox "ErrorDescription: " & objItem.ErrorDescription
        MsgBox "ErrorMethodology: " & objItem.ErrorMethodology
        MsgBox "Index: " & objItem.Index
        MsgBox "InstallDate: " & objItem.InstallDate
        MsgBox "InterfaceType: " & objItem.InterfaceType
        MsgBox "LastErrorCode: " & objItem.LastErrorCode
        MsgBox "Manufacturer: " & objItem.Manufacturer
        MsgBox "MaxBlockSize: " & objItem.MaxBlockSize
        MsgBox "MaxMediaSize: " & objItem.MaxMediaSize
        MsgBox "MediaLoaded: " & objItem.MediaLoaded
        MsgBox "MediaType: " & objItem.MediaType
        MsgBox "MinBlockSize: " & objItem.MinBlockSize
        MsgBox "Model: " & objItem.Model
        MsgBox "Name: " & objItem.Name
        MsgBox "NeedsCleaning: " & objItem.NeedsCleaning
        MsgBox "NumberOfMediaSupported: " & objItem.NumberOfMediaSupported
        MsgBox "Partitions: " & objItem.Partitions
        MsgBox "PNPDeviceID: " & objItem.PNPDeviceID
        If IsNull(objItem.PowerManagementCapabilities) Then
            MsgBox "PowerManagementCapabilities: "
          Else
            MsgBox "PowerManagementCapabilities: " & Join(objItem.PowerManagementCapabilities, ",")
        End If
        MsgBox "PowerManagementSupported: " & objItem.PowerManagementSupported
        MsgBox "SCSIBus: " & objItem.SCSIBus
        MsgBox "SCSILogicalUnit: " & objItem.SCSILogicalUnit
        MsgBox "SCSIPort: " & objItem.SCSIPort
        MsgBox "SCSITargetId: " & objItem.SCSITargetId
        MsgBox "SectorsPerTrack: " & objItem.SectorsPerTrack
        MsgBox "Signature: " & objItem.Signature
        MsgBox "Size: " & objItem.size
        MsgBox "Status: " & objItem.status
        MsgBox "StatusInfo: " & objItem.StatusInfo
        MsgBox "SystemCreationClassName: " & objItem.SystemCreationClassName
        MsgBox "SystemName: " & objItem.SystemName
        MsgBox "TotalCylinders: " & objItem.TotalCylinders
        MsgBox "TotalHeads: " & objItem.TotalHeads
        MsgBox "TotalSectors: " & objItem.TotalSectors
        MsgBox "TotalTracks: " & objItem.TotalTracks
        MsgBox "TracksPerCylinder: " & objItem.TracksPerCylinder
    Next objItem
Sinnvollerweise sollte anstatt des MsgBox-Befehls entweder alles in einer MsgBox zusammengefasst werden, oder die Daten in Userform-Textboxen geschrieben werden.
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:28
Rufname:

WMI Drucker II - WMI Drucker II

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_PrinterConfiguration", , 48)
    For Each objItem In colItems
        MsgBox "-----------------------------------"
        MsgBox "Win32_PrinterConfiguration instance"
        MsgBox "-----------------------------------"
        MsgBox "BitsPerPel: " & objItem.BitsPerPel
        MsgBox "Caption: " & objItem.Caption
        MsgBox "Collate: " & objItem.Collate
        MsgBox "Color: " & objItem.Color
        MsgBox "Copies: " & objItem.Copies
        MsgBox "Description: " & objItem.Description
        MsgBox "DeviceName: " & objItem.DeviceName
        MsgBox "DisplayFlags: " & objItem.DisplayFlags
        MsgBox "DisplayFrequency: " & objItem.DisplayFrequency
        MsgBox "DitherType: " & objItem.DitherType
        MsgBox "DriverVersion: " & objItem.DriverVersion
        MsgBox "Duplex: " & objItem.Duplex
        MsgBox "FormName: " & objItem.FormName
        MsgBox "HorizontalResolution: " & objItem.HorizontalResolution
        MsgBox "ICMIntent: " & objItem.ICMIntent
        MsgBox "ICMMethod: " & objItem.ICMMethod
        MsgBox "LogPixels: " & objItem.LogPixels
        MsgBox "MediaType: " & objItem.MediaType
        MsgBox "Name: " & objItem.Name
        MsgBox "Orientation: " & objItem.Orientation
        MsgBox "PaperLength: " & objItem.PaperLength
        MsgBox "PaperSize: " & objItem.PaperSize
        MsgBox "PaperWidth: " & objItem.PaperWidth
        MsgBox "PelsHeight: " & objItem.PelsHeight
        MsgBox "PelsWidth: " & objItem.PelsWidth
        MsgBox "PrintQuality: " & objItem.PrintQuality
        MsgBox "Scale: " & objItem.Scale
        MsgBox "SettingID: " & objItem.SettingID
        MsgBox "SpecificationVersion: " & objItem.SpecificationVersion
        MsgBox "TTOption: " & objItem.TTOption
        MsgBox "VerticalResolution: " & objItem.VerticalResolution
        MsgBox "XResolution: " & objItem.XResolution
        MsgBox "YResolution: " & objItem.YResolution
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:32
Rufname:

WMI Grafikkarte und Grafikauflösung auslesen - WMI Grafikkarte und Grafikauflösung auslesen

Nach oben
       Version: Office 2003

Code:
    Dim strComputer As String
    Dim objWMIService
    Dim colItems
    Dim objItem
   
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_VideoController", , 48)
    For Each objItem In colItems
        MsgBox "-----------------------------------"
        MsgBox "Win32_VideoController instance"
        MsgBox "-----------------------------------"
        If IsNull(objItem.AcceleratorCapabilities) Then
            MsgBox "AcceleratorCapabilities: "
          Else
            MsgBox "AcceleratorCapabilities: " & Join(objItem.AcceleratorCapabilities, ",")
        End If
        MsgBox "AdapterCompatibility: " & objItem.AdapterCompatibility
        MsgBox "AdapterDACType: " & objItem.AdapterDACType
        MsgBox "AdapterRAM: " & objItem.AdapterRAM
        MsgBox "Availability: " & objItem.Availability
        If IsNull(objItem.CapabilityDescriptions) Then
            MsgBox "CapabilityDescriptions: "
          Else
            MsgBox "CapabilityDescriptions: " & Join(objItem.CapabilityDescriptions, ",")
        End If
        MsgBox "Caption: " & objItem.Caption
        MsgBox "ColorTableEntries: " & objItem.ColorTableEntries
        MsgBox "ConfigManagerErrorCode: " & objItem.ConfigManagerErrorCode
        MsgBox "ConfigManagerUserConfig: " & objItem.ConfigManagerUserConfig
        MsgBox "CreationClassName: " & objItem.CreationClassName
        MsgBox "CurrentBitsPerPixel: " & objItem.CurrentBitsPerPixel
        MsgBox "CurrentHorizontalResolution: " & objItem.CurrentHorizontalResolution
        MsgBox "CurrentNumberOfColors: " & objItem.CurrentNumberOfColors
        MsgBox "CurrentNumberOfColumns: " & objItem.CurrentNumberOfColumns
        MsgBox "CurrentNumberOfRows: " & objItem.CurrentNumberOfRows
        MsgBox "CurrentRefreshRate: " & objItem.CurrentRefreshRate
        MsgBox "CurrentScanMode: " & objItem.CurrentScanMode
        MsgBox "CurrentVerticalResolution: " & objItem.CurrentVerticalResolution
        MsgBox "Description: " & objItem.Description
        MsgBox "DeviceID: " & objItem.DeviceID
        MsgBox "DeviceSpecificPens: " & objItem.DeviceSpecificPens
        MsgBox "DitherType: " & objItem.DitherType
        MsgBox "DriverDate: " & objItem.DriverDate
        MsgBox "DriverVersion: " & objItem.DriverVersion
        MsgBox "ErrorCleared: " & objItem.ErrorCleared
        MsgBox "ErrorDescription: " & objItem.ErrorDescription
        MsgBox "ICMIntent: " & objItem.ICMIntent
        MsgBox "ICMMethod: " & objItem.ICMMethod
        MsgBox "InfFilename: " & objItem.InfFilename
        MsgBox "InfSection: " & objItem.InfSection
        MsgBox "InstallDate: " & objItem.InstallDate
        MsgBox "InstalledDisplayDrivers: " & objItem.InstalledDisplayDrivers
        MsgBox "LastErrorCode: " & objItem.LastErrorCode
        MsgBox "MaxMemorySupported: " & objItem.MaxMemorySupported
        MsgBox "MaxNumberControlled: " & objItem.MaxNumberControlled
        MsgBox "MaxRefreshRate: " & objItem.MaxRefreshRate
        MsgBox "MinRefreshRate: " & objItem.MinRefreshRate
        MsgBox "Monochrome: " & objItem.Monochrome
        MsgBox "Name: " & objItem.Name
        MsgBox "NumberOfColorPlanes: " & objItem.NumberOfColorPlanes
        MsgBox "NumberOfVideoPages: " & objItem.NumberOfVideoPages
        MsgBox "PNPDeviceID: " & objItem.PNPDeviceID
        If IsNull(objItem.PowerManagementCapabilities) Then
            MsgBox "PowerManagementCapabilities: "
          Else
            MsgBox "PowerManagementCapabilities: " & Join(objItem.PowerManagementCapabilities, ",")
        End If
        MsgBox "PowerManagementSupported: " & objItem.PowerManagementSupported
        MsgBox "ProtocolSupported: " & objItem.ProtocolSupported
        MsgBox "ReservedSystemPaletteEntries: " & objItem.ReservedSystemPaletteEntries
        MsgBox "SpecificationVersion: " & objItem.SpecificationVersion
        MsgBox "Status: " & objItem.status
        MsgBox "StatusInfo: " & objItem.StatusInfo
        MsgBox "SystemCreationClassName: " & objItem.SystemCreationClassName
        MsgBox "SystemName: " & objItem.SystemName
        MsgBox "SystemPaletteEntries: " & objItem.SystemPaletteEntries
        MsgBox "TimeOfLastReset: " & objItem.TimeOfLastReset
        MsgBox "VideoArchitecture: " & objItem.VideoArchitecture
        MsgBox "VideoMemoryType: " & objItem.VideoMemoryType
        MsgBox "VideoMode: " & objItem.VideoMode
        MsgBox "VideoModeDescription: " & objItem.VideoModeDescription
        MsgBox "VideoProcessor: " & objItem.VideoProcessor
    Next objItem
    Set colItems = objWMIService.ExecQuery("SELECT *" _
                                          & " FROM Win32_DisplayConfiguration", , 48)
    For Each objItem In colItems
        MsgBox "-----------------------------------"
        MsgBox "Win32_DisplayConfiguration instance"
        MsgBox "-----------------------------------"
        MsgBox "BitsPerPel: " & objItem.BitsPerPel
        MsgBox "Caption: " & objItem.Caption
        MsgBox "Description: " & objItem.Description
        MsgBox "DeviceName: " & objItem.DeviceName
        MsgBox "DisplayFlags: " & objItem.DisplayFlags
        MsgBox "DisplayFrequency: " & objItem.DisplayFrequency
        MsgBox "DitherType: " & objItem.DitherType
        MsgBox "DriverVersion: " & objItem.DriverVersion
        MsgBox "ICMIntent: " & objItem.ICMIntent
        MsgBox "ICMMethod: " & objItem.ICMMethod
        MsgBox "LogPixels: " & objItem.LogPixels
        MsgBox "PelsHeight: " & objItem.PelsHeight
        MsgBox "PelsWidth: " & objItem.PelsWidth
        MsgBox "SettingID: " & objItem.SettingID
        MsgBox "SpecificationVersion: " & objItem.SpecificationVersion
    Next objItem
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:47
Rufname:

Style-Liste erstellen - Style-Liste erstellen

Nach oben
       Version: Office 2003

Code:
Sub StyleListeErstellen()
    Dim docThis As Document
    Dim styItem As Style
    Dim sBuiltIn(499) As String
    Dim iStyBICount As Integer
    Dim sUserDef(499) As String
    Dim iStyUDCount As Integer
    Dim sInUse(499) As String
    Dim iStyIUCount As Integer
    Dim iParCount As Integer
    Dim J As Integer, K As Integer
    Dim sParStyle As String
    Dim bInUse As Boolean
   
    ' Ref the active document
    Set docThis = ActiveDocument
    ' Styles sammeln
    iStyIUCount = 0
    iParCount = docThis.Paragraphs.Count
    iParOut = 0
    For J = 1 To iParCount
        sParStyle = docThis.Paragraphs(J).Style
        For K = 1 To iStyIUCount
            If sParStyle = sInUse(K) Then Exit For
        Next K
        If K = iStyIUCount + 1 Then
            iStyIUCount = K
            sInUse(iStyIUCount) = sParStyle
        End If
    Next J
    iStyBICount = 0
    iStyUDCount = 0
    ' Benutzte Styles
    For Each styItem In docThis.Styles
        'see if in those being used
        bInUse = False
        For J = 1 To iStyIUCount
            If styItem.NameLocal = sInUse(J) Then bInUse = True
        Next J
        'Unbenutzte Styles
        If Not bInUse Then
            If styItem.BuiltIn Then
                iStyBICount = iStyBICount + 1
                sBuiltIn(iStyBICount) = styItem.NameLocal
              Else
                iStyUDCount = iStyUDCount + 1
                sUserDef(iStyUDCount) = styItem.NameLocal
            End If
        End If
    Next styItem
    'Ausgabedokument erstellen
    Documents.Add
    Selection.TypeText "Styles in Benutzung"
    Selection.TypeParagraph
    For J = 1 To iStyIUCount
        Selection.TypeText sInUse(J)
        Selection.TypeParagraph
    Next J
    Selection.TypeParagraph
    Selection.TypeParagraph
   
    Selection.TypeText "Built-in Styles die nicht verwendet werden"
    Selection.TypeParagraph
    For J = 1 To iStyIUCount
        Selection.TypeText sBuiltIn(J)
        Selection.TypeParagraph
    Next J
    Selection.TypeParagraph
    Selection.TypeParagraph
   
    Selection.TypeText "User-defined Styles die nicht verwendet werden"
    Selection.TypeParagraph
    For J = 1 To iStyIUCount
        Selection.TypeText sUserDef(J)
        Selection.TypeParagraph
    Next J
    Selection.TypeParagraph
    Selection.TypeParagraph
End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:51
Rufname:

Testdateien in RTF umwandeln - Testdateien in RTF umwandeln

Nach oben
       

Code:
Sub RTFConverter()
    Dim myPath As String
    Dim MyName As String
    Dim MyName2 As String
    Dim Auswahl As String
   
    myPath = "C:\Texte\"
    If Len(myPath) = 0 Then Exit Sub
    If Asc(myPath) = 34 Then
        myPath = Mid$(myPath, 2, Len(myPath) - 2)
    End If
    MyName = Dir$(myPath & "*.txt")
    Do While MyName <> ""
        Documents.Open FileName:=myPath + MyName, ConfirmConversions:=False _
                     , ReadOnly:=False, AddToRecentFiles:=False _
                     , PasswordDocument:="", PasswordTemplate:="" _
                     , Revert:=False, WritePasswordDocument:="" _
                     , WritePasswordTemplate:="", Format:=wdOpenFormatAuto _
                     , Encoding:=1252
        MyName2 = Left(MyName, Len(MyName) - 4)
        ActiveDocument.SaveAs FileName:=myPath + MyName2 _
                            , FileFormat:=wdFormatRTF, LockComments:=False _
                            , Password:="", AddToRecentFiles:=True _
                            , WritePassword:="", ReadOnlyRecommended:=False _
                            , EmbedTrueTypeFonts:=False _
                            , SaveNativePictureFormat:=False _
                            , SaveFormsData:=False, SaveAsAOCELetter:=False
        ActiveDocument.Close
        MyName = Dir
    Loop
End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:52
Rufname:

Letzten User beim speichern in Formfield schreiben - Letzten User beim speichern in Formfield schreiben

Nach oben
       Version: Office 2003

Code:
Function GetUserName() As String
    Dim objWSHNetwork As Object
   
    On Error Resume Next
    Set objWSHNetwork = CreateObject("WScript.Network")
    GetUserName = objWSHNetwork.username + " " + objWSHNetwork.computername
    Debug.Print objWSHNetwork.computername
    Debug.Print objWSHNetwork.UserDomain
    'MsgBox objWSHNetwork.UserName
    Set objWSHNetwork = Nothing
End Function

Sub AnwenderEreignis_DocumentBeforeSave(ByVal Doc As Document _
                                      , SaveAsUI As Boolean, Cancel As Boolean)
    GetUserName
    ActiveDocument.FormFields("Benutzer").Result = GetUserName
    'MsgBox GetUserName
End Sub
Der Code schreibt in das Formfield beim speichern des Dokuments den Benutzer rein. Beim Aufruf des Dokuments steht unten im Formfield der Name des letzten Benutzers.
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 08:54
Rufname:

Zuweisen einer Tastenkombination zu einem Makro per VBA - Zuweisen einer Tastenkombination zu einem Makro per VBA

Nach oben
       

Code:
    With Application
        .CustomizationContext = ThisDocument
        .KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyAlt, wdKeyS) _
                       , KeyCategory:=wdKeyCategoryCommand _
                       , Command:="Testmakro"
    End With
Die WDKey-Liste gibt es in der MSDN.
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 12:49
Rufname:

Document Properties listen (Custom + BuildIn) - Document Properties listen (Custom + BuildIn)

Nach oben
       Version: Office 2003

Code:
Sub CustomDocumentProperties()
    Dim MyRange
    Dim Prop
   
    Set MyRange = Activedocument.Content
    MyRange.Collapse Direction:=wdCollapseEnd
    For Each Prop In Activedocument.CustomDocumentProperties
        With MyRange
            .InsertParagraphAfter
            .InsertAfter Prop.Name & " = "
            .InsertAfter Prop.Value
        End With
    Next Prop
End Sub

Sub BuildInDocumentProperties()
    Dim CurrentDoc As Document
    Dim SummDoc As Document
    Dim Prop As DocumentProperty
   
    Set CurrentDoc = Activedocument
    Set SummDoc = Documents.Add
    On Error Resume Next
    For Each Prop In CurrentDoc.BuiltInDocumentProperties
        SummDoc.Content.InsertAfter Prop.Name & " = "
        SummDoc.Content.InsertAfter Prop.Value
        SummDoc.Content.InsertParagraphAfter
    Next Prop
    Set CurrentDoc = Nothing
    Set SummDoc = Nothing
End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 12:54
Rufname:

Seite einrichten (hier Querformat mit Ränder setzen) - Seite einrichten (hier Querformat mit Ränder setzen)

Nach oben
       

Code:
Sub SeiteImQuerformat()
    Dim MyRange
   
    'Application.WindowState = wdWindowStateNormal
    'ActiveDocument.ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit
    Set MyRange = Selection.Range
    MyRange.WholeStory
    'MyRange.Font.Name = "Verdana"
    With Activedocument.PageSetup
        .Orientation = wdOrientLandscape 'wdOrientPortrait
        ' 0.394 entspricht 1 cm, 0,039 enspricht 0,1 cm
        .TopMargin = InchesToPoints(0.394)
        .BottomMargin = InchesToPoints(0.394)
        .LeftMargin = InchesToPoints(0.827)
        .RightMargin = InchesToPoints(0.394)
        '.PageWidth = InchesToPoints(8.27)
        '.PageHeight = InchesToPoints(11.69)
    End With
End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 13:02
Rufname:


Dokumentenschutz - Dokumentenschutz

Nach oben
       Version: Office 2003

Code:
' Schutz aufheben
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect Password:="123"
    End If
' Schutz setzen (mit Sektionen) für Formfields
    ActiveDocument.Sections(1).ProtectedForForms = True
    ActiveDocument.Sections(2).ProtectedForForms = False
    ActiveDocument.Sections(3).ProtectedForForms = False
    ActiveDocument.Sections(4).ProtectedForForms = True
    ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True _
                         , Password:="123"
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Gehe zu Seite Zurück  1, 2, 3  Weiter
Diese Seite Freunden empfehlen

Seite 2 von 3
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Word Formate: Einfügen/Datei - Formatierungen übernehmen (Zeilenabstand) 5 Germknödl 188 05. Sep 2013, 22:58
MarkMH_K Einfügen/Datei - Formatierungen übernehmen (Zeilenabstand)
Keine neuen Beiträge Word Serienbriefe: Excel Datei als Datenquelle, Limit an Feldern? 1 mcflyjule 283 18. Jul 2013, 08:26
MarkMH_K Excel Datei als Datenquelle, Limit an Feldern?
Keine neuen Beiträge Word Serienbriefe: Inhaltssteuerelemente nach Öffnen der Datei löschbar 0 Daniel57 202 22. Okt 2012, 12:44
Daniel57 Inhaltssteuerelemente nach Öffnen der Datei löschbar
Keine neuen Beiträge Word Formate: Öffnen der Datei, Anzahl der Aufrufe weiterzählen! 3 melly89 988 06. Jul 2011, 10:46
Gast Öffnen der Datei, Anzahl der Aufrufe weiterzählen!
Keine neuen Beiträge Word Formate: Formatänderung beim einfügen einer Datei 0 sebastian.e 403 06. Nov 2010, 00:01
sebastian.e Formatänderung beim einfügen einer Datei
Keine neuen Beiträge Word Formate: PowerPoint Datei einbinden: Dateipfad anzeigen? 0 hans.merkel1983 1903 07. Mai 2010, 11:42
hans.merkel1983 PowerPoint Datei einbinden: Dateipfad anzeigen?
Keine neuen Beiträge Word Formate: dot Datei Format und Kästen festmachen 1 J.P.S. 1084 26. Aug 2009, 18:40
DocTemplate dot Datei Format und Kästen festmachen
Keine neuen Beiträge Word Serienbriefe: Word Template aus Feldern einer Quell- Datei füllen 1 realdave 892 10. Jul 2009, 12:10
Gast Word Template aus Feldern einer Quell- Datei füllen
Keine neuen Beiträge Word Formate: Autotext aus einer anderen Datei kopieren 7 ullistein 3814 29. Aug 2008, 11:49
ullistein Autotext aus einer anderen Datei kopieren
Keine neuen Beiträge Word Serienbriefe: Serienbrief - Daten aus 2 Tabellenblättern einer EXCEL Datei 1 drivetech01 5248 10. Jan 2008, 21:04
Hübi Serienbrief - Daten aus 2 Tabellenblättern einer EXCEL Datei
Keine neuen Beiträge Word Formate: Datei/Neu ist weg ! 1 Battlecat 602 09. Aug 2007, 13:37
iso Datei/Neu ist weg !
Keine neuen Beiträge Word Serienbriefe: jede Seite eines Worddokuments in eigene Datei speichern 1 computerschmied 2625 30. März 2007, 12:24
Gast jede Seite eines Worddokuments in eigene Datei speichern
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: JavaScript