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
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:
04. Aug 2010, 13:03
Rufname:

Zwischenablage löschen - Zwischenablage löschen

Nach oben
       Version: Office 2003

Code:
Sub ZwischenablageLöschen()
    Dim ZW As DataObject
   
    Set ZW = New DataObject
    ZW.SetText ""
    ZW.PutInClipboard
End Sub
MarcSLK
Word seit 4.0 (DOS


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


Ort zu PLZ suchen - Ort zu PLZ suchen

Nach oben
       

Code:
Private Sub OrtZuPLZSuchen()
    Dim Nummer As Double
    Dim i As Long
    Dim lZähler As Long
    Dim Übergabestring As String
    Dim appXl As Object
   
    Nummer = Val(Dokumentenvorlagen.PLZ.Text)
    If Nummer > 0 Then
        'Excel öffnen (unsichtbar) und Tabelle öffnen
        Set appXl = CreateObject("Excel.Application")
        appXl.Workbooks.Open "K:\Vorlagen\PLZ.xls" 'pfad anpassen
        'UF.Listbox1 löschen
        If UF1.ListBox1.ListCount > 0 Then
            UF1.ListBox1.Clear
        End If
        'Spalte 1 alle Zeilen nach ID durchsuchen
        For i = 1 To 13090 '"Zeilenanzahl der Tabelle"
            ' jetzt bist Du in der richtigen Zeile
            If appXl.sheets(1).Cells(i, 1).Value = Nummer Then
                UF1.ListBox1.AddItem appXl.sheets(1).Cells(i, 2).Value
                Übergabestring = appXl.sheets(1).Cells(i, 2).Value
                lZähler = lZähler + 1
            End If
        Next i
        If lZähler = 1 Then 'nur ein Eintrag
            Dokumentenvorlagen.Ort.Text = Übergabestring
          Else
            UF1.Show
        End If
        appXl.Workbooks.Close
        'Excel schliessen
        appXl.Quit
    End If
    Set appXl = Nothing
End Sub
Achtung: Name der Userform und Pfad zur PLZ-Datei müssen angepasst werden.

Es wird eine Userform mit zwei Textboxen "PLZ" und "Ort" benötigt und eine zusätzliche Userform "UF1" mit einer ListBox1 und zwei Commandbuttons.

Die Suchroutine berücksichtigt mehrere Orte mit der selben PLZ. Haben mehrere Orte die selbe PLZ können diese Orte über die "UF1"-Userform ausgewählt und in die TextBox "Ort" der ersten Userform übertragen werden.[*]



PLZ.xls
 Beschreibung:

Download
 Dateiname:  PLZ.xls
 Dateigröße:  1.49 MB
 Heruntergeladen:  162 mal

MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 14:10
Rufname:

Screenshot mit VBA erstellen - Screenshot mit VBA erstellen

Nach oben
       Version: Office 2003

Code:
Option Explicit
 
Declare Function MapVirtualKey Lib "user32" Alias _
    "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Sub keybd_event Lib "user32" _
    (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long _
   , ByVal dwExtraInfo As Long)
Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long

Public Const VK_MENU = &H12
Public Const KEYEVENTF_KEYUP = &H2
 
Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Public Sub GetWindowSnapShot(Mode As Long)
    Dim altscan%, NT As Boolean
   
    NT = IsNT
    If Not NT Then
        If Mode = 0& Then Mode = 1& Else Mode = 0&
    End If
    If NT And Mode = 0 Then
        keybd_event vbKeySnapshot, 0&, 0&, 0&
      Else
        altscan = MapVirtualKey(VK_MENU, 0)
        keybd_event VK_MENU, altscan, 0, 0
        DoEvents
        keybd_event vbKeySnapshot, Mode, 0&, 0&
    End If
    DoEvents
    keybd_event VK_MENU, altscan, KEYEVENTF_KEYUP, 0
End Sub

Public Function IsNT() As Boolean
    Dim verinfo As OSVERSIONINFO
   
    verinfo.dwOSVersionInfoSize = Len(verinfo)
    If (GetVersionEx(verinfo)) = 0 Then Exit Function
    If verinfo.dwPlatformId = 2 Then IsNT = True
End Function

Sub Screenshot()
    'gesamten Bildschirm: GetWindowSnapShot 0
    'oder nur das aktives Fenster:
    GetWindowSnapShot 1
End Sub
MarcSLK
Word seit 4.0 (DOS


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

Prüfung ob Datei vorhanden ist - Prüfung ob Datei vorhanden ist

Nach oben
       Version: Office 2003

Code:
Option Explicit

Public Datei As String
Public GetPfad As String
Public strFehler As String

Function DateiVorhanden(Dateiname As String, Optional Pfad As String = "") _
                       As Boolean
    Dim strDateiname As String
    Dim strPfad As String

    strPfad = Pfad
    If Not IsMissing(strPfad) Then
        If Right(strPfad, 1) <> "\" Then
            strPfad = strPfad & "\"
        End If
    End If
    strDateiname = strPfad & Dateiname
    If Len(Dir(strDateiname)) > 0 Then
        DateiVorhanden = True
      Else
        DateiVorhanden = False
    End If
End Function

Sub DateiVorhandenTest()
    Dim strDatei As String
    Dim strPfad As String
    Dim strMeldung As String
   
    strDatei = "Test.doc"
    strPfad = "K:\"
    strMeldung = "Die Datei ist im Ordner '" & strPfad
    If DateiVorhanden(strDatei, strPfad) = True Then
        MsgBox strMeldung & "' vorhanden.", vbInformation, "Dateiprüfung"
        strFehler = "0"
      Else
        MsgBox strMeldung & "' nicht vorhanden. Bitte geben Sie einen " _
             & "gültigen Dateipfad ein oder verständigen Sie Ihren " _
             & "Administrator.", vbInformation, "Dateiprüfung"
        strFehler = "1"
    End If
End Sub
MarcSLK
Word seit 4.0 (DOS


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


wdkey-Liste - wdkey-Liste

Nach oben
       

wdkey-Liste


wdkey-Liste.doc
 Beschreibung:

Download
 Dateiname:  wdkey-Liste.doc
 Dateigröße:  36.5 KB
 Heruntergeladen:  161 mal

MarcSLK
Word seit 4.0 (DOS


Verfasst am:
04. Aug 2010, 15:44
Rufname:

Nur Zahlen in Userform-Textbox zulassen - Nur Zahlen in Userform-Textbox zulassen

Nach oben
       Version: Office 2003

Code:
Private Sub PLZ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
      Case 48 To 57
      Case Else     
          KeyAscii = 0
    End Select
End Sub
Die Textbox in der Userform hat in dem vorliegenden Beispiel den Namen "PLZ".
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
27. Sep 2010, 09:44
Rufname:

Outlook-Termin (ganzer Tag) aus Word anlegen - Outlook-Termin (ganzer Tag) aus Word anlegen

Nach oben
       

Verweis auf die "Microsoft Outlook xx Object Library"

Code in ein Modul eintragen:

Public Function CreateAppointment(SubjectStr As String, BodyStr As String, StartTime As Date, EndTime As Date, AllDay As Boolean)

Dim OlApp As Outlook.Application
Dim Appt As Outlook.AppointmentItem

Set OlApp = CreateObject("Outlook.Application")
Set Appt = OlApp.CreateItem(olAppointmentItem)

Appt.Subject = SubjectStr
Appt.Start = StartTime
Appt.End = EndTime
Appt.AllDayEvent = AllDay
Appt.Body = BodyStr
Appt.Save
Set Appt = Nothing
Set OlApp = Nothing

End Function



Private Sub OutLokkTerminAnlegen()

CreateAppointment "Testtermin", "Testtermintext", "27.09.2010", "28.09.2010", True

End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
27. Sep 2010, 11:15
Rufname:

Alle Dokumente eines Verzeichnisses zusammenführen - Alle Dokumente eines Verzeichnisses zusammenführen

Nach oben
       

Sub AlleDokumenteEinesVerzeichnissesZusammenführen()

ChDir "C:\"
myVerz = Dir("*.DOC")

Documents.Add

While myVerz <> ""

With Selection
.InsertFile FileName:=myVerz, ConfirmConversions:=False
.InsertParagraphAfter
.InsertBreak Type:=wdSectionBreakNextPage
.Collapse Direction:=wdCollapseEnd
End With

myVerz = Dir()
Wend

End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
28. Sep 2010, 11:41
Rufname:

Daten aus einer Excel-Tabelle in Variable - Daten aus einer Excel-Tabelle in Variable

Nach oben
       

Sub DatenAusExcelHolen()

Dim Übergabestring As String

Set appXl = CreateObject("Excel.Application")
appXl.Workbooks.Open "C:\Mappe1.xls" 'Pfad anpassen

Übergabestring = appXl.sheets(1).Cells(2, 2).Value
MsgBox Übergabestring 'nur zum Test

appXl.Workbooks.Close

'Excel schliessen
Set appXl = Nothing

End Sub

Der Code holt aus der Excel-Datei mit dem Namen "Mappe1" auf Laufwerk "C:" aus dem ersten Tabellenblatt den Wert der "Zweiten Spalte - Zweite Zeile".
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
30. Sep 2010, 07:41
Rufname:

Datepicker abfragen - Datepicker abfragen

Nach oben
       

Private Sub DTPicker1_Change()

If DTPicker1.Value = Format(Now, "dd.mm.yyyy") Then
GoTo Beenden:

Else

Datum.Text = DTPicker1.Value

End If

Beenden:
End Sub

Funktionsweise des Codes:
Wenn im Datepicker das aktuelle Datum gewählt wird, passiert gar nichts, da das aktuelle Datum bereits im Feld Datum.Text steht. Wird ein anderes Datum als das aktuelle Datum ausgewählt, wird diese Auswahl in das Feld Datum.Text übertragen.
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
30. Sep 2010, 10:05
Rufname:

Alle Inlineshapes eines Dokuments auf x cm Höhe ändern - Alle Inlineshapes eines Dokuments auf x cm Höhe ändern

Nach oben
       Version: Office 2003

Sub AlleInlineshapesAuf10ZentimeterSetzen()

Dim myShape As InlineShape

WunschhöheCM = 5

For Each myShape In ActiveDocument.InlineShapes

Faktor = Application.CentimetersToPoints(WunschhöheCM)
Faktor = Faktor / myShape.Height
myShape.Height = myShape.Height * Faktor
myShape.Width = myShape.Width * Faktor

Next myShape

End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
07. Jan 2011, 12:11
Rufname:

Standarddrucker per WMI auslesen - Standarddrucker per WMI auslesen

Nach oben
       

Sub StandarddruckerPerWMIAuslesen()

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = True")

For Each objItem In colItems

MsgBox "Name: " & objItem.Name

Next

End Sub
MarcSLK
Word seit 4.0 (DOS


Verfasst am:
12. Jan 2011, 13:45
Rufname:


Alle Inlineshapes eines Word-Dokuments als JPG BMP speichern - Alle Inlineshapes eines Word-Dokuments als JPG BMP speichern

Nach oben
       Version: Office 2003

Sub InlineshapesAusWordSpeichern()

' Verweis auf Microsoft ActiveX Data Object Library muss gesetzt sein

Set ImageStream = CreateObject("ADODB.Stream")

anzahl = ActiveDocument.InlineShapes.Count

For i = 1 To ActiveDocument.InlineShapes.Count

strBild = "c:\Bild" & i & ".jpg" 'oder .bmp

With ImageStream
.Type = 1
.Open
.Write ActiveDocument.InlineShapes(i).Range.EnhMetaFileBits
.SaveToFile strBild
.Close
End With

Next

Set ImageStream = Nothing

End Sub
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

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

Seite 3 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: MS Frontpage