Kategorie: VBA

Microsoft Project – Ausnahmen für Kalender per VBA aus Excel importieren

In den jeweiligen Kalendern von Project können Ausnahmen für arbeitsfreie Tage eingetragen werden. Liegt eine Liste mit diesen Ausnahmen in Excel vor, kann diese nicht einfach per Copy und Paste in ihrer Gesamtheit kopiert werden. Schade.

p01

Damit Project auf Excel im VBA zugreifen kann, muss in Extras – Verweise der Zugriff auf Microsoft Excel gewährt werden. Zunächst mit ALT + F11 den VBA-Editor öffnen, dann den Zugriff gewähren.

p11

Anschließend den unten stehenden Code in ein neues Modul kopieren und den Pfad zur Datei anpassen.

Folgender VBA-Code öffnet zunächst eine Excel-Datei und liest anschließend Zeilenweise die Daten der jeweiligen Ausnahmen in die Ausnahmeliste des Kalenders „Standard“:

Sub Feiertage_Importieren()
Dim xlApp As Excel.Application
Dim xlWkb As Workbook
Dim i As Long
Dim Bezeichnung As String
Dim Startdatum As Date
Dim Enddatum As Date

Set xlApp = CreateObject(„Excel.Application“)
Set xlWkb = xlApp.Workbooks.Open(„C:\Users\Andreas\Desktop\KalenderStandard.xlsx“)

i = 2

With xlWkb.Sheets(„Feiertage“)
Do Until .Cells(i, 1).Value = „“

Bezeichnung = .Cells(i, 1).Value
Startdatum = .Cells(i, 2).Value
Enddatum = .Cells(i, 3).Value

ActiveProject.BaseCalendars(„Standard“).Exceptions.Add Type:=1, Name:=Bezeichnung, Start:=Startdatum, Finish:=Enddatum

i = i + 1
Loop
End With

xlWkb.Close
Set xlWkb = Nothing
Set xlApp = Nothing
End Sub

Achtung: Das Makro beinhaltet noch keine Fehlerprozeduren und prüft nicht, ob die Termine eventuell schon vorhanden sind.

Nun kann das Makro z.B. mit Alt + F8 ausgeführt werden.
Unter Projekt – Arbeitszeit ändern lassen sich die neuen Ausnahmen einsehen.

p21

Videolink:

Link zum Video bei YouTube: http://youtu.be/3advDEF3iyo

Excel – Userform – VBA-Formulare

Anbei findet ihr die Übungsdatei aus der Reihe VBA-Tutorial Userforms – Formulare mit Excel – Teil 1 und 2.
Die Datei stand längere Zeit nicht zur Verfügung. Hier liegen sind bereits weitere Modifikationen eingearbeitet.

Excel_163_UserForm

Hier noch einmal das Videotutorial aus dem Jahr 2012:

Videolink: http://youtu.be/uJbv-Fo83_U

Das zweite Video mit der Combobox:

Videolink: http://youtu.be/SchJkqneMbU

Excel – Wahlweise Formeln oder Eingaben in Zellen – VBA

Wahlweise können Formeln oder manuelle Eingaben in einer Zelle stehen. Doch wenn Formeln durch Eingaben überschrieben werden, verschwindet die Formel und beim Löschen der Eingabe wird die Formel nicht automatisch neu gesetzt. Bis jetzt…

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
‚Andreas Thehos, 2014
Dim Zelle As Range
Dim a As Variant
Dim Zeilenzahl As Long
Zeilenzahl = WorksheetFunction.Max(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, _
ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row)

For Each Zelle In ActiveSheet.Range(„B2:B“ & Zeilenzahl)
a = Zelle.Offset(0, -1).Value
If a = „“ Or IsNumeric(a) = False Then
Zelle.Value = „“
Else
If Zelle.Value = „“ Then Zelle.Formula = „=RC[-1]*0.05“
End If

Next Zelle
End Sub

Link zum Video:

Videolink: http://youtu.be/ApnKNK1Lv7A

Excel – Diagrammfarben per VBA zuweisen

Den Datenreihen meines Diagramms möchte ich feste Farbwerte zuweisen. Die gleiche Stadt soll im Diagramm immer die gleiche Farbe zugewiesen bekommen.

Wie das Makro funktioniert, sehen Sie hier:

Videolink: http://youtu.be/_1ue9imc4yc

VBA-Code:
Sub Farben_Diagramm()

Dim chtDiagramm As Chart
Dim i As Integer, j As Integer, intColor As Integer, intSeries As Integer
Dim strName As String, strChart As String, strBlatt As String
On Error GoTo ErrorHandler
    strBlatt = „Versuch“
    strChart = „chartPersonal“

    Set chtDiagramm = Sheets(strBlatt).ChartObjects(strChart).Chart
    intSeries = chtDiagramm.SeriesCollection.Count

    chtDiagramm.SetElement (msoElementDataLabelNone)
    chtDiagramm.SetElement (msoElementDataLabelCenter)

    For i = 1 To intSeries
        strName = chtDiagramm.SeriesCollection(i).Name
        For j = 2 To Range(„rng_Orte“).Value + 1
            If Sheets(„Versuch“).Cells(j, 9).Value = strName Then
                intColor = Sheets(„Versuch“).Cells(j, 14).Value
                With chtDiagramm.SeriesCollection(strName)
                    .Format.Fill.Visible = msoTrue
                    .Format.Fill.ForeColor.RGB = RGB(Sheets(„Versuch“).Cells(j, 11).Value, _
                        Sheets(„Versuch“).Cells(j, 12).Value, Sheets(„Versuch“).Cells(j, 13).Value)
                       
                    With .DataLabels.Format.TextFrame2.TextRange.Font.Fill
                        .ForeColor.RGB = RGB(intColor, intColor, intColor)
                        .Solid
                    End With
                    .DataLabels.Format.TextFrame2.TextRange.Font.Bold = msoTrue
                End With
               
            End If
        Next j
    Next i
   
    Exit Sub
   
ErrorHandler:
    MsgBox „Ein Fehler ist aufgetreten“, vbInformation, „Fehler “ & Err.Number
End Sub

Wie kommt man auf so einen Code? Ich habe mir die Makroaufzeichnung zu Nutze gemacht:

Videolink: http://youtu.be/iHae8Su6GGo

Hier wird der Code von oben erläutert:

Videolink: http://youtu.be/Yrl7-PZiMjg

Excel – Vorlagen

XLT – Mustervorlagen Typ Excel 97-2003
XLTX – Mustervorlagen Typ Excel 2007-2013
XLTM – Mustervorlagen mit Makros Excel 2007-2013

Speicherort für benutzerbezogene Vorlagen:
C:\Users\Anmeldename\Documents\Benutzerdefinierte Office-Vorlagen

Mustervorlagen sind über einen rechten Mausklick und den Kontextmenüeintrag ÖFFNEN zu ändern. Ein Doppelklick auf eine Mustervorlage erzeugt eine neue Arbeitsmappe.

Hier geht es zum ersten Video:

Videolink:http://youtu.be/w1qEJXmhAZg

So lange es nur eigene Mustervorlagen gibt, heißt der Eintrag für benutzerbezogene Vorlagen PERSÖNLICH. Werden aber Arbeitsgruppenvorlagen verwendet, ändert sich der Eintrag auf BENUTZERDEFINIERT. Logisch, oder?!

Die Arbeitsgruppenvorlagen werden in Word unter DATEI – OPTIOENEN – ERWEITERT bei den Speicherorten eingetragen und stehen dann für alle Office-Anwendungen zur Verfügung. Richtig gelesen: Bei Word!

Zusätzlich können auch Verknüpfungen zu Mustervorlagen in die Vorlagenverzeichnisse kopiert werden. Die Vorlagen werden dann über ihre Verknüpfungen aufgerufen.

Wer ein wenig Ordnung herstellen möchte, kann Unterordner in die Vorlagenverzeichnisse legen. Befinden sich tatsächlich passende Dateien in diesen Ordnern, werden diese auch im Vorlagenbereich zur Auswahl angezeigt.

Hier ist das zweite Video zu den Ordnern:

Videolink: http://youtu.be/k2rH0rpYnpg

Über Mustervorlagen können aber auch eigene Symbole für die Symbolleiste für den Schnellzugriff zur Verfügung gestellt werden. So können in XLTM-Dateien zum Beispiel Makros beinhaltet sein und die Vorlage liefert dann eigene Schaltflächen zur Ausführung des Makros mit.

Hier ist das Video zur Anpassung der Symbolleiste für den Schnellzugriff

Videolink:http://youtu.be/5R4Bb–ixsE

Excel – Anzahl der Personen einer Altersgruppe ermitteln – DATEDIF

Liegt in einer Liste das jeweilige Geburtsdatum vor, kann mit der Funktion DATEDIF(Ausgangsdatum, Späteres Datum, „Y“) das Alter in abgeschlossenen Jahren ermittelt werden.
DATEDIF ist innerhalb von Excel nicht dokumentiert. Folgende Parameter können in DATEDIF genutzt werden:

„Y“ Volle Jahre
„M“ Volle Monate
„D“ Volle Tage
„MD“ Differenz in Tagen, wenn volle Monate bereits berücksichtigt wurden
„YM“ Differenz in Monaten, wenn abgeschlossene Jahre bereits berücksichtigt wurden
„YD“ Differenz in Tagen, wenn abgeschlossene Jahre bereits berücksichtigt wurden

482a

Die Formel
=SUMMENPRO
DUKT((DATEDIF(tab_Liste[Geburtstag];HEUTE();"Y")>=20)*(DATEDIF(tab_Liste[Geburtstag];HEUTE();"Y")<30))

ermittelt, bei wie vielen Prüfungen zum einen der vordere Teil mit der Prüfung >=20 WAHR ist und gleichzeitig bei der hinteren die Prüfung <30 WAHR ist. WAHR multipliziert mit WAHR ergibt den Wert 1, alle anderen Rechnungen ergeben 0*0, 1*0 bzw. 0*1 und somit den Wert Null. SUMMENPRODUKT ermittelt hier also nur die Anzahl der Werte, die im gesuchten Intervall liegen.

Hier gibt es die Übungsdatei:
Excel 482 Personen im Datumsbereich

Hier geht es zum Video:

Videolink: http://youtu.be/Uwo1PnqyaGw

Hier ist auch noch ein Video zur Funktion DATEDIF:

Videolink: http://youtu.be/4g8mE6P0ONw

Excel – Kreuztabelle per VBA in Liste umwandeln

Per VBA soll eine Kreuztabelle in eine strukturierte Liste gewandelt werden.
Der Code steht auch in der Excel-Tabelle zur Verfügung. Wie der Code funktioniert, kann im unten aufgeführten Video betrachtet werden. Wichtig ist allerdings, dass die erste Datenspalte der Kreuztabelle angeklickt wird, ansonsten findet die Umwandlung nicht korrekt statt.

Die Kreuztabelle wurde bewusst in Spalte B aufgehängt, da ich in Spalte A die Angaben zu den zusätzlichen Überschriften eintrage. Man hätte hier natürlich auch ein neues Register ins Menüband integrieren können.

Option Explicit

Sub KreuztabelleListe()
‚Erstellt von Andreas Thehos, 2014
‚zur Erstellung einer Datenliste ausgehend von kreuztabellierten Daten

Dim wksKreuztabelle As Worksheet ‚Kreuztabelle – Ausgangsdaten
Dim wksZieltabelle As Worksheet ‚Zieltabelle – wird erzeugt
Dim intStartspalte As Integer ‚Spalte der ersten kreuztabellierten DATEN
Dim intAuswertungAntwort As Integer ‚Antwort auf Frage der MsgBox
Dim lngLetzteZeile As Long ‚Letzte Zeile
Dim intLetzteSpalte As Integer ‚Letzte Spalte
Dim j As Long ‚Zähler für Zeilen aus Kreuztabelle
Dim k As Long ‚Zähler für Zeilen in Zieltabelle
Dim i As Integer ‚Zähler für Spalten aus Kreuztabelle
Dim m As Integer ‚Zähler für Spaltenwerte

On Error GoTo ErrorHandler

Application.ScreenUpdating = False ‚Bildschirmaktualisierung aus
Set wksKreuztabelle = ActiveSheet ‚Das aktuelle Blatt wird auf wksKreuztabelle gelegt

‚Ermittlung und Prüfung, wo die Daten der Kreuztabelle beginnen
intStartspalte = ActiveCell.Column

intAuswertungAntwort = MsgBox(„Kreuztabellierte Daten beginnen in Spalte “ & _
intStartspalte – 1 & “ der Kreuztabelle?“, vbInformation + vbYesNo)

Select Case intAuswertungAntwort
Case vbYes
Case vbNo
MsgBox „Markieren Sie bitte die erste Datenzelle der Kreuztabelle und “ & _
„führen Sie das Makro erneut aus.“, vbInformation, „Bitte neu Markieren“
Exit Sub
End Select

‚Ermittlung der letzten Spalte und Zeile der Kreuztabelle
intLetzteSpalte = wksKreuztabelle.Range(„IV1“).End(xlToLeft).Column
lngLetzteZeile = wksKreuztabelle.Range(„B65536“).End(xlUp).Row

Set wksZieltabelle = Sheets.Add(After:=Worksheets(Worksheets.Count))

wksKreuztabelle.Activate
k = 2

‚Hier werden die Daten aber Zeile 2 in die Zieltabelle gesetzt
For i = intStartspalte To intLetzteSpalte
For j = 2 To lngLetzteZeile
If wksKreuztabelle.Cells(j, i).Value „“ Then
With wksZieltabelle
For m = 2 To intStartspalte – 1
.Cells(k, m – 1).Value = wksKreuztabelle.Cells(j, m).Value
Next m
‚Hier wird die Überschriftenspalte der Daten in die vorletzte Spalte geschrieben
.Cells(k, intStartspalte – 1).Value = „‚“ & wksKreuztabelle.Cells(1, i).Value
‚Hier werden die Daten in die letzte Spalte geschrieben
.Cells(k, intStartspalte).Value = wksKreuztabelle.Cells(j, i).Value
k = k + 1
End With
End If
Next j
Next i

‚Hier werden die Überschriften der Zieltabelle gesetzt
For m = 2 To intStartspalte – 1
wksZieltabelle.Cells(1, m – 1).Value = wksKreuztabelle.Cells(1, m).Value
Next m

‚Es folgen die Überschriften der Daten, die nicht direkt ersichtlich sind
wksZieltabelle.Cells(1, intStartspalte – 1).Value = wksKreuztabelle.Cells(12, 1).Value
wksZieltabelle.Cells(1, intStartspalte).Value = wksKreuztabelle.Cells(15, 1).Value

Set wksZieltabelle = Nothing
Set wksKreuztabelle = Nothing

Application.ScreenUpdating = True
Exit Sub

‚Im Falle des Fehlerfalles
ErrorHandler:
MsgBox „Ein Fehler ist aufgetreten.“
Application.ScreenUpdating = True
End Sub

Hier ist die XLSM-Datei zur Umwandlung einer Kreuztabelle in eine strukturierte Liste:
Kreuztabellierte_Daten

Hier ist das Video:

Videolink: http://youtu.be/1H-L80AJflU