Schlagwort: VBA

Veröffentlicht am

Zeilenumbrüche bei MsgBox, InputBox, TextBox, …

Zeilenumbrüche bei MsgBox, InputBox, TextBox, etc. lassen sich mit vbCrLf einfügen.
Im nachfolgenden Code wird das beispielhaft an einer TextBox aufgezeigt.

UserForm1.TextBox11.Value = "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text" & vbCrLf & _
                            "Das ist ein sehr langer Text"

Veröffentlicht am

Werte Kopieren von Quell- in Ziel-Tabelle

Mit diesem Makro lassen sich sehr leicht Werte aus einer Quelle in eine andere Ziel-Tabelle kopieren.

  • Es wird für jede definierte Rage (Spalte) die letze beschriebene Zeile ermittelt.
  • In die Tabelle Ziel wird eine Formel für den Übertrag der Werte aus Ziel eingetragen.
  • Die Formeln werden nach erfolgreichem übertrag überschrieben.

Quelle

Ziel

Sub KopiereABASUsersOrg()
'
' Kopiert die Originalwerte aus Quelle in Ziel
'

Application.ScreenUpdating = False

' Tabelle: Quelle     ' Source
' Tabelle Ziel: Ziel    ' Ziel
' Kopiere das Austrittsdatum aus den PMS-Daten-Rohdaten
'
    ' Ermittelt die letzte befüllte Zelle der Tabelle Ziel
    Dim Letzte As Long
    Worksheets("Ziel").Activate
    Letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ' Ermittelt die letzte befüllte Zelle der Tabelle Ziel
   
    ' Ermittelt die letzte befüllte Zelle der Tabelle Quelle
    Dim quelle_letzte As Long
    Worksheets("Quelle").Activate
    quelle_letzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    ' Ermittelt die letzte befüllte Zelle der Tabelle Quelle


    ' B3 - Schreibt die Formel in die Zelle
    Worksheets("Ziel").Range("B3").FormulaLocal = _
    "=WENN('Quelle'!B3="""";"""";'Quelle'!B3)"
        ' Kopiert die Formel ans Ende der Spalte
    Worksheets("Ziel").Activate
    Range("B3").AutoFill Destination:=Range("B3:B" & quelle_letzte), Type:=xlFillDefault
    
    ' D3 - Schreibt die Formel in die Zelle
    Worksheets("Ziel").Range("C3").FormulaLocal = _
    "=WENN('Quelle'!C3="""";"""";'Quelle'!C3)"
        ' Kopiert die Formel ans Ende der Spalte
    Worksheets("Ziel").Activate
    Range("C3").AutoFill Destination:=Range("C3:C" & quelle_letzte), Type:=xlFillDefault
    

    
    Letzte = 0
    quelle_letzte = 0

Call FormelnEntfernen

Application.ScreenUpdating = True
End Sub

Mit diesem Makro können die gesetzten Formeln in der Tabelle „Ziel“ entfernt werden.

Private Sub FormelnEntfernen()
'
' Kopiert die Werte in Tabelle "Ziel", um die Formeln zu ersetzen
'

Application.ScreenUpdating = False

 Worksheets("Ziel").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Veröffentlicht am

Credits in UserForm

In meinem letzten Beitrag „Dokumenteneigenschaften“ habe ich gezeigt, wie man die Dokumenteneigenschaften per VBA manipulieren kann.

Ich persönlich finde es auch immer ganz schön, wenn man dem Benutzer diese Informationen auch über ein UserForm (falls vorhanden) ausgibt.

Es muss pro Textfeld ein Wert eingetragen werden. Der Textname lässt sich einfach identifizieren, einfach in das Feld klicken.

Der Code, der das Feld mit einem Wert füllt sieht so aus:

UserForm1.TextBox1.Value = "Das ist Text"

In meinem Beitrag „Dokumenteneigenschaften“ habe ich globale Konstanten definiert, die man auch für diesen Zweck verwenden kann.
Dazu erstellen wir ein neues Makro mit dem Namen „CreditNotesEinfügen“

Sub CreditNotesEinfügen()
'
' Credit Notes werden in das Userform geladen
'

UserForm1.TextBox1.Value = "Title: " & Title
UserForm1.TextBox2.Value = "Company: " & Company
UserForm1.TextBox3.Value = "Department: " & Department
UserForm1.TextBox4.Value = "Author: " & Author
UserForm1.TextBox5.Value = "Version: " & Version & " / " & Month & " " & Year
UserForm1.TextBox6.Value = Date
UserForm1.TextBox7.Value = Time
UserForm1.TextBox9.Value = ThisWorkbook.Path
UserForm1.TextBox10.Value = ThisWorkbook.Name
UserForm1.TextBox13.Value = "Contact: " & EMail
End Sub

Zu beachten ist, dass vor einem Aufruf des UserForm die Felder befüllt werden müssen, ansonsten sieht der Benutzer nur ein leeres Feld.

Sub UserForm()
'
' Startet das UserForm
'

Call CreditNotesEinfügen

UserForm.Show
End Sub

Veröffentlicht am

Dokumenteneigenschaften manipulieren

Dokumenteneigenschaften

Mit Hilfe dieses Makros können die Dokumenteneigenschaften einer Excel-Datei manipuliert werden.

Die Konstanten habe ich global definiert, so können die auch für andere Zwecke in anderen Modulen angesprochen werden.
Im eigentlichen Makro „Dokumenteneigenschaften“ wird auf diese Konstanten zurückgegriffen und die Werte dort abgeholt.

Global Const Title As String = "Dokumententitel"
Global Const Company As String = "Firma"
Global Const Department As String = "Abteilung"
Global Const Author As String = "Stefan Strobel"
Global Const Version As String = "1.0"
Global Const Year As String = "2017"
Global Const Month As String = "June"
Global Const EMail As String = "meine@e-mail.de"


Sub Dokumenteneigenschaften()
'
' Schreibt die Dokumenteneigenschaften
'

ActiveWorkbook.BuiltinDocumentProperties("Title") = Title
ActiveWorkbook.BuiltinDocumentProperties("Author") = Author
ActiveWorkbook.BuiltinDocumentProperties("Company") = Company
ActiveWorkbook.BuiltinDocumentProperties("Subject") = "Meine bestes Dokument"
ActiveWorkbook.BuiltinDocumentProperties("KeyWords") = ""
ActiveWorkbook.BuiltinDocumentProperties("Comments") = ""

End Sub

Damit die Dokumenteneigenschaften sofort beim Öffnen der Excel-Datei eingetragen werden kann man das Makro über die Funktion AutoOpen aufrufen lassen.

Sub Auto_Open()

Call Dokumenteneigenschaften

End Sub

Veröffentlicht am

Microsoft Excel – Kopf- und Fußzeile mit einem Marko flexibel und schnell anpassen

Mit Hilfe von VBA lassen sich die Kopf- und Fußzeile sehr einfach und schnell befüllen.


Global Const Title As String = "Titel"
Global Const Company As String = "Company"
Global Const Department As String = "Department"
Global Const Author As String = "Stefan Strobel"
Global Const Version As String = "1.0"
Global Const Year As String = "2015"
Global Const Month As String = "Month"
Global Const EMail As String = "help@me"


Sub KopfFußZeile()
    With ActiveSheet.PageSetup
        .LeftHeader = "&8" & Title & vbCr & "Version: " & Version & " / " & Month & " " & Year
        .CenterHeader = "&8"
        .RightHeader = "&8"
        .LeftFooter = "&8" & Company & vbCr & Department
        .CenterFooter = "&8Created on: " & Date & " " & Time
        .RightFooter = "&8" & " Contact: " & EMail & vbCr & "Author: " & Author
    End With
    'ActiveWindow.SelectedSheets.PrintPreview
End Sub


Anstatt die Variablen zu definieren, kann man die Einträge natürlich auch gleich direkt in die jeweiligen Kopf- und Fußzeilen-Bereiche schreiben. Da ich die Variablen aber noch mehrmals an unterschiedlichen Stellen in der Arbeitsmappe benötigt habe, habe ich diese als globale Variablen definiert.
Die Schriftgröße in der Kopf- und Fußzeile wird mit dem Befehl &8 gesetzt.

Veröffentlicht am

E-Mail via VBA aus Excel versenden

Mit Hilfe von VBA lässt sich sehr einfach eine Tabelle einer Arbeitsmappe als E-Mail versenden. Die Besonderheit hier, hat man mehrere Konten im Outlook angelegt kann man mittels dem Parameter .Session.Accounts.Item das Absendekonto auswählen. Voraussetzung ist dafür natürlich das Recht, dass man auch von diesem Konto E-Mails versenden darf.

Veröffentlicht am

Auswahlbox mit VBA erstellen

Eine Auswahlbox, wie man diese normal über Daten –> Datenüberprüfung erstellen kann, ist mit VBA ein wenig umständlicher zu erstellen.

Auswahl-Dropdown
Auswahl-Dropdown

Option Explicit

Sub Auswahl()    

Dim ws As Worksheet
Dim range1 As Range, rng As Range

ActiveSheet.Range("P7").Value = "ja" ' Darf nicht gelöscht werden
ActiveSheet.Range("P8").Value = "nein" ' Darf nicht gelöscht werden

Set ws = ActiveSheet
Set range1 = ws.Range("P7:P8")
Set rng = ws.Range("P10")

With rng.Validation
    .Delete 'delete previous validation
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Formula1:="='" & ws.Name & "'!" & range1.Address
End With

End Sub

Veröffentlicht am

Anzahl von Einträgen in einer Spalte ermitteln

In einer Spalte stehen unterschiedliche Werte, von denen einige doppelt aufgelistet werden. Man möchte aber die Anzahl der Einträge ermitteln, wobei die Doppelten nur als ein Eintrag gezählt werden sollen.

Excel VBA - Anzahl
Excel VBA – Anzahl

Option Explicit

Sub Anzahl()

Application.ScreenUpdating = False

'
' Ermittelt, wie viele unterschiedliche Einträge vorhanden sind
' Grundlage der Prüfung = Index
'
    Dim objDictionary As Object
    Dim Bereich As Variant
    Dim lngZaehler As Long
    Dim arrDaten As Variant

    Set objDictionary = CreateObject("Scripting.Dictionary")
    With Worksheets("Tabelle1")
    '
    ' Der Bereich wie dynamisch ermittelt.
    ' Dadurch wird sichergestellt, dass auch bei leeren Zellen der gesamte Bereich ausgewertet wird.
    '
        Bereich = .Range("A3", .Range("A3").End(xlDown))
        
    End With
    ' Schleife über alle Werte
    For lngZaehler = LBound(Bereich) To UBound(Bereich)
        ' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
        objDictionary(Bereich(lngZaehler, 1)) = 0
    Next
    'MsgBox "Es sind " & objDictionary.Count & " unterschiedliche Einträge vorhanden." _
    '        , vbInformation, "Anzahl Index"
    
    Worksheets("Tabelle1").Range("C2").Value = "Anzahl"
    Worksheets("Tabelle1").Range("C3").Value = objDictionary.Count
    
End Sub