AW: Userform erstellen
19.09.2013 11:26:59
Manuel
Letztendlich arbeite ich mit VBA unter MS Project. Ein Projekt wird ausgewertet und das Ergebnis in einer Excel-Datei festgehalten.
Der Part der nicht funktioniert ist gekennzeichnet. Ist auch unabhängig von dem Rest des Makros (denke ich).
Private Sub LAM_AktArbeit_an_Stichtag_ausrichten(sCase As String)
Dim ProProj As Project, ProProject As Project
Dim ProP As Project
Dim ResR As Resource
Dim ResRs As Resources
Dim AssAssignments As Assignments
Dim AssAssignment As Assignment
Dim IntRessources As Integer, i As Integer
Dim IntType As Integer
Dim IntTS As Integer
Dim IntFormat As Integer
Dim IntGrundlast As Integer
Dim IntLastMonth As Integer
Dim LonWorkTotal As Long
Dim StrNumber As String
Dim BooFlag As Boolean
Dim vRow() As Variant
Dim DatDateFrom As Date
Dim DatDateTo As Date
Dim UserForm as Object
Dim Label as object
GloBooEnd = False
'---- Info zum Makro und Einlesen des Stichtags --------------------------------------------
IntLastMonth = -1
Do
StrNumber = InputBox("Das Makro liest die Zeitreihen ""aktuelle Arbeit"" und ""Arbeit"" _
auf Monatsbasis pro Mitarbeiter aus " & vbCrLf & _
"(es werden nur Vorgänge betrachtet, die innerhalb des Jahres liegen - die _
Korrekturen werden in einer Excel-Tabelle dargestellt)." & vbCrLf & vbCrLf & _
"1) Mitarbeiter hat ""akt. Arbeit"" nach dem Stichtag:" & vbCrLf & _
" - Die Summe der hinter dem Stichtag liegende Arbeit" & vbCrLf & _
" - wird auf die Monate vor dem Stichtag, die bereits" & vbCrLf & _
" - einen Eintrag in ""aktuelle Arbeit"" haben, verteilt." & vbCrLf & _
vbCrLf & _
"Bitte den letzten Monat für ""akt. Arbeit"" angeben " & vbCrLf & _
"(z.b. ""4"" für April):", _
Title:="LAM_Report_AktuelleArbeit_an_Stichtag_ausrichten", Default:="5")
If IsNumeric(StrNumber) Then IntLastMonth = CDec(StrNumber)
If Not IsNumeric(StrNumber) And StrNumber "" Then MsgBox "Der eingegebene Wert war _
keine Zahl oder außerhalb des Bereichs 1..12."
If (IntLastMonth 12) And StrNumber "" Then MsgBox "Der _
eingegebene Wert war keine Zahl oder außerhalb des Bereichs 1..12."
Loop While Not (IntLastMonth >= 1 And IntLastMonth ""
If StrNumber = "" Then Exit Sub
'--- setzen der Parameter, da Rumpf des Programms für das Befüllen der Excel-Datei aus dem _
Macro
' zum Auslesen der Ressourcen übernommen wurde
IntTS = 3
IntFormat = 3
IntGrundlast = 1
gbFlagMeldungVerteilungAktuelleArbeitShow1 = True
Set ProProj = ActiveProject
'--- Vorbereiten Report ----------------------------------------------------------
InitialisePlan2ProjectAssignments
ReDim vRow(400)
vRow(1) = ProProj.Name
BooFlag = SetReport(ciSetReportOpen)
BooFlag = SetReport(ciSetReportHeader, IntTS, vRow, DatDateFrom, DatDateTo, IntFormat)
'--- Setzen des aktuellen Projekts -----------------------------------------------
ProProj.Activate
'--- Eigentliche Schleife über alle Ressourcen ------------------------------------
'########################HIER DER WICHTIGE TEIL!###########################
Set UserForm = Application.VBE.ActiveVBProject.VBComponents.Add(vbtext_ct_MSForm)
with Userform
.Properties("Height")= 200
.Properties("Width") = 200
.Properties("Caption") = "Verteilung"
.Name = "Test"
end with
Set Label = Userform.Designer.Controls.Add("Forms.Label.1")
with Label
.Caption = "Beispiel"
.Left = 10
.Top = 10
.Height= 30
.Width= 180
end with
IntRessources = ProProj.Resources.Count
Set ResRs = ProProj.Resources
For Each ResR In ResRs
If Not ResR Is Nothing Then
i = i + 1
If i Mod 10 = 0 Then SetExcelStatusBar i & " von " & IntRessources
Set AssAssignments = ResR.Assignments
For Each AssAssignment In AssAssignments
vRow = vKorrekturAktuellerArbeit_und_Arbeit(ResR, AssAssignment, IntLastMonth, _
sCase)
BooFlag = SetReport(ciSetReportRowPPMS, 1, vRow)
If GloBooEnd = True Then
MsgBox "Es ist ein Fehler in der Dokumentation aufgetreten. Bitte starten _
sie das Programm erneut.", vbSystemModal
Exit Sub
End If
Next AssAssignment
End If
Next ResR
MsgBox "es sind" & Chr(13) & GloIntCount & Chr(13) & "Terminänderungen aufgetreten", _
vbSystemModal
SetExcelStatusBar ""
'--- Formatieren des Reports -------------------------------------------------------
BooFlag = SetReport(2, IntTS, IntFormat:=IntFormat)
If IntFormat = ciFormatPivot Then BooFlag = SetReport(ciSetReportPivot)
ReDim vRow(400)
vRow(1) = ProProj.Name
BooFlag = SetReport(ciSetReportWriteParameter, IntTS, vRow, DatDateFrom, DatDateTo, _
IntFormat)
BooFlag = SetReport(ciSetReportClose)
Das komplette Makro ist noch länger würde aber hier den Rahmen sprengen. Die Formatierung ist auch nicht perfekt aber wie gesagt Profi bin ich nicht. Das Problem besteht weiterhin, dass das UserForm nicht wie gewünscht geöffnet wird. Ich möchte in MS Project via VBA ein UserForm öffnen, wo ich Objekte erzeugen kann ohne das ständig Laufzeitfehler kommen.
Gruß