eingebettete Objekte

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm MsgBox
Bild

Betrifft: eingebettete Objekte von: jan-und-jana
Geschrieben am: 14.02.2005 14:32:26

Was sind eingebetette Objekte?

Ich habe folgendes Problem:
http://support.microsoft.com/?scid=kb;de;329410

Erklärung meiner Excel-Datei:
- ich starte ExcelVorlage.xlt
- ein internes Generator-Modul generiert 12 Worksheets (für jeden Monat)
- es werden ein paar Zellen befüllt
- Formeln generiert
- VBE.Code für jedes Sheet generiert
- alles klappt wunderbar, selbst der generierte Code arbeitet korrekt

Will ich nun die Datei abspeichern als '*.xls', dann erscheint das oben erwehnte Problem. Und aus der Erklärung von MS werde ich nicht wirklich schlau.

Bild


Betrifft: AW: eingebettete Objekte von: Sven
Geschrieben am: 14.02.2005 14:36:48

Anrede
Frage
Gruß

mfg Sven


Bild


Betrifft: AW: eingebettete Objekte von: jan-und-jana
Geschrieben am: 14.02.2005 14:56:43

Sorry, wollte natürlich nicht unhöflich erscheinen!

Hallo erstmal,

Ich habe folgendes Problem:
http://support.microsoft.com/?scid=kb;de;329410
darus folgt:Was sind eingebetette Objekte?
Sind Worksheet-,Collection-, UserForm-Objekte eingebettete Objekte? Andere benutze ich in miener Datei nicht.

Erklärung meiner Excel-Datei:
- ich starte ExcelVorlage.xlt
- ein internes Generator-Modul generiert 12 Worksheets (für jeden Monat)
- es werden ein paar Zellen befüllt
- Formeln generiert
- VBE.Code für jedes Sheet generiert
- alles klappt wunderbar, selbst der generierte Code arbeitet korrekt

Will ich nun die Datei abspeichern als '*.xls', dann erscheint das oben erwehnte Problem. Und aus der Erklärung von MS werde ich nicht wirklich schlau.

Im vorraus vielen Dank für die schnelle Hilfe,
jan-und-jana


Bild


Betrifft: AW: eingebettete Objekte von: Sven
Geschrieben am: 14.02.2005 15:06:51

Hi,

das sind eigentlich keine Objekte im Sinne des Artikels.
Könnt ihr mal ein Beispiel hochladen?

mfg Sven


Bild


Betrifft: AW: eingebettete Objekte von: jan-und-jana
Geschrieben am: 16.02.2005 09:43:03

Hallo nochmal,

Hier liefere ich den Code meiner Arbeitsmappe( besser Vorlage) ,aus dem meine Arbeitsmappe generiert wird.
Zum besseren Verständniss erkläre ich kurz meine 'Modul-Architektur':
1. Das Generator-Modul steuert den Generierungs-Prozess (diesen Code zeige ich auch hier)
2. Das Kalendar-Modul liefert mir die Feiertage und Wochenenden eines Monats(eigentlich nur Date- und Integer-Operationen)
3. Das FormelKonverter-Modul generiert mir die Formeln für die enstsprechende Zelle (eigentlich nur String-Operationen)
4. meine Vorlage enthält noch ein Formular welches zu Beginn gestartet wird und im Dialog Standartwerte vom User erhält und den Generator-Prozess anschiebt
5. Zwei Worksheets sind Standart-Mäßig enthalten, eines um die Standarteinstellungen zu speichern (verborgen) und eines um zur Laufzeit auf ständige Ereignisse zu reagieren (nicht groß)
6. Hier folgt der Code des Generator-Moduls, welches mit Abstand das größte ist:
Private dateStandartwerte(3) As Date
'--------------------------------------------------------------------------->
'Schnittstelle: wird nur vom OpenFormular gerufen
'<---------------------------------------------------------------------------
Public Sub startGeneration()
dateStandartwerte(0) = OpenFormular.getTime("Arbeitsbeginn")
dateStandartwerte(1) = OpenFormular.getTime("Arbeitsende")
dateStandartwerte(2) = OpenFormular.getTime("Pause_von")
dateStandartwerte(3) = OpenFormular.getTime("Pause_bis")
Call CreateSheets
End Sub
'-------------------------------------------------------------------------------------------------->
'[Schnittstelle]->wurde erst später zur Schnittstelle, durch Projekte
'liefert ein verbundens Range-Objekt
'diese Funktion ist Public, wiel sie bei der erzeugung der Projekte/Worksheet-Monat
'benötigt wird
'<-------------------------------------------------------------------------------------------------
Public Function mergeCells(ByVal objRangeStart As Range, _
intAnzahl As Integer, _
ByVal objWorksheet As Worksheet) As Range
Dim objRangeReturn As Range
With objWorksheet
Set objRangeReturn = .Range(.Cells(objRangeStart.Row, objRangeStart.Column), _
.Cells(objRangeStart.Row, (objRangeStart.Column + intAnzahl - 1)))
End With
objRangeReturn.mergeCells = True

Set mergeCells = objRangeReturn

Set objRangeReturn = Nothing
Set objRangeStart = Nothing
Set objWorksheet = Nothing
End Function

'---------------------------------------------------------------------------->
'Erste bearbeitung vom Mario Stockmann (12.2004)
'Weitere Bearbeitung durch Jan Winter (01.2005)
'Schnittstelle: des Generators (wird vom Workbook.open-Event gerufen)
'Es werden 12 Sheets an die bestehenden Sheets angefügt.
'Den input-Dialog ggf. über ein Formular gestallten.
'<----------------------------------------------------------------------------
Private Sub CreateSheets()
    Dim strYear As String
    
'    strYear = CStr(Year(Now)) 'später wird ein geprüftes Jahr von OpenFormular.getJahr geholt
    strYear = CStr(Year(OpenFormular.getTime("Jahr")))
'    dateStandartwerte(0) = CDate("8:00")
'    dateStandartwerte(1) = CDate("16:30")
'    dateStandartwerte(2) = CDate("12:00")
'    dateStandartwerte(3) = CDate("12:30")
    If strYear <> "" Then
'        für alle 12 Monate Arbeitsblätter anlegen
        For nCounter = 1 To 12
'            Monat anlegen
            Call CreateSheet(CDate("1." & CStr(nCounter) & "." & CStr(strYear)))
        Next
    End If
'            MsgBox CStr(CDate("1." & CStr(5) & "." & CStr(strYear)))
'            Call CreateSheet(CDate("1." & CStr(5) & "." & CStr(strYear)))
On Error GoTo EH:
Exit Sub
EH:
End Sub

'
Private Sub CreateSheet(dateFirstInMonth As Date)
On Error GoTo EH:
    Dim objCurSheet As Excel.Worksheet
    
    'ein neues Sheet wird erzeugt
    ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count())
    'eine Referenz auf das neue Sheet wird geholt
    Set objCurSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count())
    objCurSheet.Name = Format(dateFirstInMonth, "mmmm") '{Januar, Februar, März,...}
    
    Call Layout.setColumnWidth(objCurSheet, True)
    Call createKopf(objCurSheet)
    Call createMonatsTage(objCurSheet, dateFirstInMonth)
    Call createSummenRow(objCurSheet)
    Call createEventProcedure
    Call Layout.fixiereKopfUndDatum(objCurSheet)
    Call Layout.updateStandartwerte(dateStandartwerte(0), dateStandartwerte(1), dateStandartwerte(2), dateStandartwerte(3), CStr(Year(dateFirstInMonth)))
    Call OpenFormular.addStatusLine("MONAT " + objCurSheet.Name + " wurde erstellt.")
    Set objCurSheet = Nothing
Exit Sub
EH:
End Sub

'---------------------------------------------------------------------------->
'Erzeugt den Tabellen-Kopf in einem Übergebenen Sheet
'mögliche existierende Daten würden überschrieben werden
'Worksheet objWorksheet:= das zu editierende Worksheet
'<----------------------------------------------------------------------------
Private Sub createKopf(objWorksheet As Worksheet)
    Dim objCurRange As Range
    Dim intStartColumn, intEndColumn, intStartRow, intEndRow, _
        intIndexColumn, intIndexRow As Integer
    
    intStartColumn = 1
    intEndColumn = 11
    intStartRow = 1
    intEndRow = 2
    For intIndexRow = intStartRow To intEndRow
        For intIndexColumn = intStartColumn To intEndColumn
            Set objCurRange = objWorksheet.Cells(intIndexRow, intIndexColumn)
            Select Case intIndexColumn
                Case 1:
                    If intIndexRow = 1 Then
                        Set objCurRange = mergeCells(objCurRange, 3, objWorksheet)
                        objCurRange.Value = "Datum"
                    End If
                Case 2:
                    If intIndexRow = 1 Then
                        '1.Zeile,2.Spalte leer
                    Else
                        '2.Zeile,2.Spalte leer
                    End If
                Case 3:
                    If intIndexRow = 1 Then
                        '1.Zeile,3.Spalte leer
                    Else
                        objCurRange.Value = "Typ"
                    End If
                Case 4:
                    If intIndexRow = 1 Then
                        Set objCurRange = mergeCells(objCurRange, 2, objWorksheet)
                        objCurRange.Value = "Arbeitszeit"
                    Else
                        objCurRange.Value = "Beginn"
                    End If
                Case 5:
                    If intIndexRow = 1 Then
                        '1.Zeile,5.Spalte leer
                    Else
                        objCurRange.Value = "Ende"
                    End If
                Case 6:
                    If intIndexRow = 1 Then
                        Set objCurRange = mergeCells(objCurRange, 2, objWorksheet)
                        objCurRange.Value = "Pause"
                    Else
                        objCurRange.Value = "von"
                    End If
                Case 7:
                    If intIndexRow = 1 Then
                        '1.Zeile,7.Spalte leer, weil merged
                    Else
                        objCurRange.Value = "bis"
                    End If
                Case 8:
                    If intIndexRow = 1 Then
                        Set objCurRange = mergeCells(objCurRange, 3, objWorksheet)
                        objCurRange.Value = "Auswertung"
                    Else
                        objCurRange.Value = "Ist"
                    End If
                Case 9:
                    If intIndexRow = 1 Then
                        '1.Zeile,9.Spalte leer weil merged
                    Else
                        objCurRange.Value = "Soll"
                    End If
                Case 10:
                    If intIndexRow = 1 Then
                        '1.Zeile,10.Spalte leer, weil merged
                    Else
                        objCurRange.Value = "Diff"
                    End If
                Case 11:
                    If intIndexRow = 1 Then
                        objCurRange.Value = "Projekte"
                    Else
                        objCurRange.Value = "Summe"
                    End If
            End Select
            Call Layout.setLayout("Kopf", objCurRange, "komplett")
        Next intIndexColumn
    Next intIndexRow
    Set objCurRange = Nothing
End Sub

'---------------------------------------------------------------------------->
'liefert die linke,nächste Celle als Range-Objekt (nur Horizontal)
'<----------------------------------------------------------------------------
Private Function getNextCell(objCurRange As Range, objWorksheet As Worksheet) As Range
    Dim objRangeReturn As Range
    Dim intColumn, intRow As Integer
    
    intColumn = objCurRange.Column
    intRow = objCurRange.Row
    Set objRangeReturn = objWorksheet.Cells(intRow + 1, intColumn)
'    MsgBox CStr(objRangeReturn.Row) + "," + CStr(objRangeReturn.Column)
    
    Set getNextCell = objRangeReturn
    Set objRangeReturn = Nothing
End Function

'----------------------------------------------------------------------------->
'
'<-----------------------------------------------------------------------------
Private Sub createMonatsTage(objWorksheet As Worksheet, dateFirstInMonth As Date)
    Dim intRowStart, intRowEnde, intColumnStart, intColumnEnde, _
        intRowIndex, intColumnIndex As Integer
    Dim boolWochenende, boolFeiertag As Boolean
    Dim strWochentag, strFeiertag, strLayoutName As String
    Dim dateTmp As Date
    Dim objCurRange As Range
    
    
    intRowStart = 3
'    intRowEnde = intRowStart + Kalender.Monatstage(intMonat, _
'                                            OpenFormular.getJahr())
    intRowEnde = (intRowStart - 1) + Kalendar.Monatstage(CInt(Month(dateFirstInMonth)), _
                                                   CInt(Year(dateFirstInMonth)))
    intColumnStart = 1
    intColumnEnde = 11
    dateTmp = dateFirstInMonth
    ' Für Jede Zeile über alle Zeilen
    For intRowIndex = intRowStart To intRowEnde
        'isWochenende setzt boolWochenende + strWochentag{Mo,Di,Mi,...}
        boolWochenende = Kalendar.isWochenende(dateTmp)
        boolFeiertag = Kalendar.isFeiertag(dateTmp, "SA", True)
        ' Für jede Spalte ber alle Spalten
        For intColumnIndex = intColumnStart To intColumnEnde
            Set objCurRange = objWorksheet.Cells(intRowIndex, intColumnIndex)
            'Alle Spalten werden wie {Tag(Zahl),Tag(Schrift)} Formatiert
            Select Case intColumnIndex
                Case 1, 3: Call Layout.setLayout("Tag(Schrift)", objCurRange, "komplett")
                Case 8, 9, 11:
                    Call Layout.setLayout("Tag(Summe)", objCurRange, "komplett")
                    objCurRange.NumberFormat = "0.00"
                Case Else:
                    Call Layout.setLayout("Tag(Zahl)", objCurRange, "komplett")
                    If intRowIndex = 10 Then
                        objCurRange.NumberFormat = "0.00"
                    End If
            End Select
            'Die Hintergründe Werden angepasst
            If boolWochenende Then
                Call Layout.setLayout("Tag(Wochenende)", objCurRange, "interior")
            Else
                If boolFeiertag Then
                    Call Layout.setLayout("Tag(Feiertag)", objCurRange, "interior")
                End If
            End If
            'Die Standart- bzw. Dfaultwerte werden gesetzt
            Call setDefaultCellValues(boolWochenende, boolFeiertag, objCurRange, _
                                      dateTmp, intRowIndex, intColumnIndex, objWorksheet)
        Next intColumnIndex
        dateTmp = DateAdd("y", CDbl(1), dateTmp)
    Next intRowIndex
    objWorksheet.Calculate
    
    Set objCurRange = Nothing
End Sub

'----------------------------------------------------------------------------->
'
'<-----------------------------------------------------------------------------
Private Function setDefaultCellValues(ByVal boolWochenende As Boolean, _
                               ByVal boolFeiertag As Boolean, _
                               objRange As Range, _
                               dateDay As Date, _
                               ByVal intRow As Integer, _
                               ByVal intColumn As Integer, _
                               objWorksheet As Worksheet)
    Dim dateCopy As Date
    'Ein Array welches die Spalte-Drei-Werte enthält:
    '{A->Arbeitstag,W->Wochenende,F->Feiertag}
    Dim strArrTagTyp(2) As String
        strArrTagTyp(0) = "A" 'Arbeitstag
        strArrTagTyp(1) = "W" 'Wochenende
        strArrTagTyp(2) = "F" 'Feiertag
    Dim strArrZeitTyp() As String
        strArrZeitTyp() = OpenFormular.getAuswahlKriterien
    
'    MsgBox dateDay
    Select Case intColumn
        Case 1:
            objRange.Value = Kalendar.getWeekDay(dateDay)
        Case 2:
            objRange.NumberFormat = "dd/mm"
'            MsgBox Format(dateDay, "dd/mm")
'            MsgBox objRange.NumberFormat
            objRange.Value = dateDay
'            dateCopy = dateDay
'            objRange.Value = dateCopy
        Case 3:
            If boolWochenende Then
                objRange.Value = strArrTagTyp(1)
            Else
                If boolFeiertag Then
                    objRange.Value = strArrTagTyp(2)
                Else
                    objRange.Value = strArrTagTyp(0)
                End If
            End If
        Case 4, 5, 6, 7:
            If boolWochenende Or boolFeiertag Then
                'hier wird nicht gearbeitet
            Else
                objRange.NumberFormat = "hh:mm"
                objRange.Value = Format(dateStandartwerte(intColumn - 4), "hh:mm")
            End If
        Case 8, 9, 10, 11:
            'Kummuliereter Wert der Tatsächlichen Arbeitszeiten
            If boolWochenende Or boolFeiertag Then
                'es pasiiert nichts
            Else
                If intColumn = 9 Then
                    objRange.Value = objWorksheet.Cells(intRow, intColumn - 1).Value
                Else
'                    Dim str As String
'                    str =
'                    Debug.Print str
                    objRange.FormulaLocal = FormelKonverter.getFormel(intRow, intColumn, "Tag")
                End If
            End If
'        Case 9:
'            'Die Summe der hören Zeilen + Netto-Arbeitszeit
            
'        Case 10:
'            'Die Differenz zwischen Ist und Soll
'        Case 11:
'            'Die summierten Projektstunden
    End Select
End Function

'----------------------------------------------------------------------------------------->
'
'<-----------------------------------------------------------------------------------------
Private Sub createSummenRow(objWorksheet As Worksheet)
    Dim intColumnStart, intColumnEnde, intColumnIndex, intRow As Integer
    Dim objRange As Range
    
    
    intColumnStart = 1
    intColumnEnde = 12
    '...SpecialCells(xlCellTypeLastCell) -> untere,rechte Ecke als Range Bsp.:(K33|K34)
    intRow = objWorksheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
    
    For intColumnIndex = intColumnStart To intColumnEnde
        Select Case intColumnIndex
            Case 1:
                Set objRange = mergeCells(objWorksheet.Cells(intRow, intColumnIndex), 7, objWorksheet)
                objRange.Value = "Summen"
                Call Layout.setLayout("Summe(Schrift)", objRange, "komplett")
            Case 2, 3, 4, 5, 6, 7:
            Case 8, 9, 10, 11:
                Set objRange = objWorksheet.Cells(intRow, intColumnIndex)
                Call Layout.setLayout("Summe(Zahl)", objRange, "komplett")
                objRange.FormulaLocal = FormelKonverter.getFormel(intRow, intColumnIndex, "Summe")
        End Select
    Next intColumnIndex
    
    Set objRange = Nothing
End Sub

'---------------------------------------------------------------------------->
'Erzeugt den Code für die Monats-Tabellen-Blätter nachdem diese erzeugt wurden
'String strWorksheet:= Worksheet-Name um das CodeModul zu identifizieren
'Erklärung der eingefügten Funktion:
' - es wird das Worksheet_Change(...)-Ereigniss eingeführt
' - falls dieses auftritt wird dieses an das Modul 'EventCatcher' weitergereicht
' und dort weiterverarbeitet.
'<----------------------------------------------------------------------------
'
Private Sub createEventProcedure(objWorksheet As Worksheet)
Private Sub createEventProcedure()
    Dim longStartLine As Long
    Dim objVbComponent As VBComponent
    
    
'    Application.ScreenUpdating = False
    
    For Each VBComponent In ActiveWorkbook.VBProject.VBComponents
        If VBComponent.Type = vbext_ct_Document And _
           VBComponent.CodeModule.CountOfLines = 0 Then
            Set objVbComponent = VBComponent
            Exit For
        End If
    Next VBComponent
    
    With objVbComponent.CodeModule
        longStartLine = .CreateEventProc("Change", "Worksheet") + 1
        .InsertLines longStartLine, "    Call EventCatcher.Worksheet_ChangeEvent(target, ActiveSheet)"
    End With
    Application.VBE.MainWindow.Visible = False ' damit der Vis.Basic.Editor-Fenster wieder geschlossen wird
    Set objVbComponent = Nothing
End Sub



 Bild

Beiträge aus den Excel-Beispielen zum Thema "eingebettete Objekte"