Hallo!
Ich hab da folgendes problem
wenn ich die funktion aufruf funktioniert alles super
startet sie aber ein 2. mal da bekomme ich den
Laufzeitfehler 1004 "die methode worksheets für das objekt _Global ist fehlgeschlagen"
Markierte zeile ist:
.Worksheets.Add After:=Worksheets(Worksheets.Count)
soweit so gut debugger abbrechen und excel ist im tastmanager noch aktiv
ergo: nächster aufruf geht
excel ist im tastmanager beendet
Laufzeitfehler 462
debugger abbrechen und es läuft wieder
Die vorgehensweise habe ich bei Word und bei Outlook aber bei Excel bekomm ich problemme und weis nicht warum
mdl_Pfad:
Public Function akt_Verz_Excel_Kalender() As String
akt_Verz_Excel_Kalender = Environ("UserProfile") & "\Desktop\"
End Function
mdl_Excel_Global:
Option Compare Database
Option Explicit
Private objExcel As Excel.Application
Private objExcelNew As Object
Private objExcel_Kalender As Object
Public Property Get CreateExcel() As Excel.Application
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Err = 0
Set objExcel = CreateObject("Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Beep
MsgBox "Verbindung zu Excel kann nicht aufgebaut werden: " & _
Err.Description, vbOKOnly + vbCritical, "Problem:"
Exit Property
End If
End If
Set CreateExcel = objExcel
End Property
Public Function Excel_New(Show As Boolean) As Object
On Error GoTo Err_ErrHandler
If Not objExcel Is Nothing Then
Set Excel_New = objExcel.Workbooks.Add
End If
If objExcel Is Nothing Then
Set objExcel = CreateExcel
objExcel.Visible = Show
Set objExcelNew = objExcel.Workbooks.Add
End If
Set Excel_New = objExcelNew
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Excel konnte nicht erstellt werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
End If
Call ResetExcel
Resume Exit_ErrHandler:
End Function
Public Sub CreateExcel_Kalender(jahr As String)
Dim Monat As Integer
Dim Tag As Integer
Dim AnzTage As Integer
Dim d As Date
Set objExcel_Kalender = Excel_New(True)
With objExcel_Kalender
For Monat = 1 To 12
AnzTage = DateSerial(Year(jahr), Monat + 1, 1) _
- DateSerial(Year(jahr), Monat, 1)
.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet
.Name = Format(DateSerial(1, Monat, 1), "mmm")
End With
Range("A1:AH2").Interior.ColorIndex = 40
Range("D1:AH1").NumberFormat = "d"
Range("D1:AH2").HorizontalAlignment = xlCenter
Range("D2:AH2").NumberFormat = "ddd"
For Tag = 1 To AnzTage
With Cells(1, Tag + 3)
d = DateSerial(jahr, Monat, Tag)
.Value = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then
Range(Cells(3, Tag + 3), (Cells(40, Tag + 3))).Interior.ColorIndex = 15
End If
Cells(2, Tag + 3) = d
End With
Next Tag
Columns("D:AH").ColumnWidth = 3
Cells(3, 1).Activate
Cells(1, 1) = "ID"
Cells(1, 2) = "Veranstaltung"
Cells(1, 3) = "Datum"
Next Monat
.SaveAs akt_Verz_Excel_Kalender & "Planung" & jahr & ".xls"
End With
Call ResetExcel
Exit Sub
End Sub
Public Sub ResetExcel()
On Error Resume Next
objExcel.Quit
If Not objExcel Is Nothing Then
Set objExcel = Nothing
End If
If Not objExcelNew Is Nothing Then
Set objExcelNew = Nothing
End If
If Not objExcel_Kalender Is Nothing Then
Set objExcel_Kalender = Nothing
End If
End Sub
Aufruf z.B.:
Private Sub cmd_Excel_Planung_Click()
If Not IsNull(cbo_Jahr) Then CreateExcel_Kalender (cbo_Jahr)
End Sub
Wäre super wenn jemand den fehler sieht
Gruß Frank
hallo
und immer wieder der selbe Fehler. Nachfolgende Excelobjecte müssen bei Fernsteuerung immer vom Excelobject abgeleitet werden, weil sonst Excel nicht beendet wird. Und die nicht beendete Excelinstance führt beim 2ten Aufruf zum Fehler.
Also alle ActiveIrgendwas, Range, Cells, Worksheets etc (und dat sind jetzt nicht wenige in deinem Code) vom Excelobject->Workbook ableiten.
relevante Zeilen:
For Monat = 1 To 12
AnzTage = DateSerial(Year(jahr), Monat + 1, 1) - DateSerial(Year(jahr), Monat, 1)
With .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
.Name = Format(DateSerial(1, Monat, 1), "mmm")
.Range("A1:AH2").Interior.ColorIndex = 40
.Range("D1:AH1").NumberFormat = "d"
.Range("D1:AH2").HorizontalAlignment = xlCenter
.Range("D2:AH2").NumberFormat = "ddd"
For Tag = 1 To AnzTage
With .Cells(1, Tag + 3)
d = DateSerial(jahr, Monat, Tag)
.Value = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then
.Range(.Cells(3, Tag + 3), (.Cells(40, Tag + 3))).Interior.ColorIndex = 15
End If
.Cells(2, Tag + 3) = d
End With
Next Tag
.Columns("D:AH").ColumnWidth = 3
.Cells(3, 1).Activate
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Veranstaltung"
.Cells(1, 3) = "Datum"
End With
Next Monat
Hallo!
erstmal danke für die hilfe!
hate ich vergessen zu erwähnen das ich die ableitung auch schon gesetzt habe
.Range und soweiter
wenn ich das mache so wie du es auch geschrieben hast dann entsteht das problem das des kalender dann nicht mehr passt aber die laufzeitfehler nicht mehr auftreten und es ja immer funzt
daher dacht ich es muss an anderer stelle liegen das problem den der karender passt ja
am beenden von excel such ich die ganze zeit schon rum
Verstanden hab ich jetzt nix, aba ich ahne was:
For Tag = 1 To AnzTage
d = DateSerial(jahr, Monat, Tag)
.Cells(1, Tag + 3).Value = d
.Cells(2, Tag + 3).Value = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then .Range(.Cells(3, Tag + 3), (.Cells(40, Tag + 3))).Interior.ColorIndex = 15
Next Tag
Bei mir wird Excel nach erzeugung der Kals beendet.
Hallo,
Zitat von: Frank77 am Januar 02, 2015, 19:14:07das problem das des kalender dann nicht mehr passt
Zitatdaher dacht ich es muss an anderer stelle liegen das problem den der karender passt ja
was passt bzw. nicht passt, musst du wohl noch etwas genauer beschreiben.
Und was genau ist hiermit gemeint:
Zitatam beenden von excel such ich die ganze zeit schon rum
?
Danke für die mühe das an zuschauen ihr 2!
wenn ich das so lasse
For Tag = 1 To AnzTage
With Cells(1, Tag + 3)
d = DateSerial(jahr, Monat, Tag)
.Value = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then
Range(Cells(3, Tag + 3), (Cells(40, Tag + 3))).Interior.ColorIndex = 15
End If
Cells(2, Tag + 3) = d
End With
Next Tag
dann sieht es aus wie auf bild richtig aber der fehler tritt auf das bei erneutem aufruf die laufzeitfehler eintreten
sind aber die punkte drin dann sieht es aus wie auf dem bild falsch
aber keine laufzeitfehler
"am beenden von excel such ich die ganze zeit schon rum"
der sub ResetExcel funzt bei Word und outlook kein thema auser bei excel auf der suche nach dem warum war ich Maggy
Gruß Frank
Hi,
daolix hatte bereits die richtige Ahnung, was die Markierung der Wochenenden betraf, tausche also den Code entsprechend aus.
Bei korrektem Bezug auf die Excel-Objekte dürfte sich dann auch das Schließen-Problem erübrigen.
Hallo!
erst mal danke an den code von daolix das klapt prima
ich hab jetzt die markierte zeile ausgetauscht nun läufts ohne probleme hinter einander ohne fehler den wenn Excel aktiv (.exe) dan wird die instance verwendet
war wohl der erste fehler
allerding ist des mango daran das wenn eine andere exceldatei geöfnet ist die auch geschlossen wird wenn der code durchläuft (ist aber erst mal unwichtig)
Public Property Get CreateExcel() As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Err = 0
Set objExcel = CreateObject("Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Beep
MsgBox "Verbindung zu Excel kann nicht aufgebaut werden: " & _
Err.Description, vbOKOnly + vbCritical, "Problem:"
Call ResetExcel
Exit Property
End If
End If
Set CreateExcel = objExcel
End Property
Excel wird aber nicht beendet und ist im tastmanager immer noch aktiv
egal wie ich es drehe und wende
ich beende es im taskmanager und führe die prozedur neu aus bekomme ich eine leere Exceltabele zu sehen und es passier weiter nix
wenn ich die tabelle dann von hand schliesse kommt eine fehlermeldung an der zeile
With .Worksheets.Add(After:=Worksheets(Worksheets.Count))
ok ist ja klarr weil es nixmehr zum zugreifen gibt
die frage ist nur warum, weshalb und wiso hält die sache vor der zeile an
(Fehler behandlung fehlt in der prozedur die das abfängt zum testen warum)
und der witz an der sache ist starte ich dann alles neu läufts sauber durch
aber excel.exe beenden is nich warum auch immer obwohl
objExcel.Quit die tabelle schliesst
Gruß Frank
Hallo
das excel nicht geschlossen wird, liegt immer noch daran das du nicht alle Objecte ableitest.
Zitatwenn ich die tabelle dann von hand schliesse kommt eine fehlermeldung an der zeile
With .Worksheets.Add(After:=Worksheets(Worksheets.Count))
Diese Zeile steht aber oben so nicht in meinem geposteten Fragment.
Um es mal auf den
Punkt zu bringen:
ZitatWith .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
so läuft es bei mir ohne zicken durch (hab jetzt aber auch keinen Stresstest durchgeführt):
Private objExcel As Excel.Application
Private objExcelNew As Object
Private objExcel_Kalender As Object
Private m_KillIfCreate As Boolean
Public Property Get CreateExcel() As Excel.Application
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Err = 0
Set objExcel = CreateObject("Excel.Application")
If Err <> 0 Or objExcel Is Nothing Then
Beep
MsgBox "Verbindung zu Excel kann nicht aufgebaut werden: " & _
Err.Description, vbOKOnly + vbCritical, "Problem:"
Exit Property
End If
m_KillIfCreate = True
End If
Set CreateExcel = objExcel
End Property
Public Function Excel_New(Show As Boolean) As Object
On Error GoTo Err_ErrHandler
If Not objExcel Is Nothing Then
Set Excel_New = objExcel.Workbooks.Add
End If
If objExcel Is Nothing Then
Set objExcel = CreateExcel
objExcel.Visible = Show
Set objExcelNew = objExcel.Workbooks.Add
End If
Set Excel_New = objExcelNew
Exit_ErrHandler:
Exit Function
Err_ErrHandler:
If Err <> 0 Then
MsgBox "Excel konnte nicht erstellt werden. " & _
Err.Description, vbOKOnly + vbCritical, "Problem !"
End If
Call ResetExcel
Resume Exit_ErrHandler:
End Function
Public Sub CreateExcel_Kalender(jahr As String)
Dim Monat As Integer
Dim Tag As Integer
Dim AnzTage As Integer
Dim d As Date
Dim vA()
Set objExcel_Kalender = Excel_New(True)
With objExcel_Kalender
For Monat = 1 To 12
AnzTage = DateSerial(Year(jahr), Monat + 1, 1) - DateSerial(Year(jahr), Monat, 1)
ReDim vA(1 To 2, 1 To AnzTage + 3)
With .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
.Name = Format(DateSerial(1, Monat, 1), "mmm")
.Range("A1:AH2").Interior.ColorIndex = 40
.Range("D1:AH1").NumberFormat = "d"
.Range("D1:AH2").HorizontalAlignment = xlCenter
.Range("D2:AH2").NumberFormat = "ddd"
For Tag = 1 To AnzTage
d = DateSerial(jahr, Monat, Tag)
vA(1, Tag + 3) = d
vA(2, Tag + 3) = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then .Range(.Cells(3, Tag + 3), (.Cells(40, Tag + 3))).Interior.ColorIndex = 15
Next Tag
vA(1, 1) = "ID"
vA(1, 2) = "Veranstaltung"
vA(1, 3) = "Datum"
.Range(.Cells(1, 1), .Cells(2, AnzTage + 3)) = vA()
.Columns("D:AH").ColumnWidth = 3
End With
Next Monat
.SaveAs akt_Verz_Excel_Kalender & "Planung" & jahr & ".xls"
.Close
End With
Call ResetExcel
Exit Sub
End Sub
Public Sub ResetExcel()
On Error Resume Next
If m_KillIfCreate = True Then objExcel.Quit
m_KillIfCreate = False
If Not objExcel Is Nothing Then
Set objExcel = Nothing
End If
If Not objExcelNew Is Nothing Then
Set objExcelNew = Nothing
End If
If Not objExcel_Kalender Is Nothing Then
Set objExcel_Kalender = Nothing
End If
End Sub
Frank,
irgendwie scheinst du nicht zu verstehen, worum es geht...
Im Anhang vom 2.1.2015 19:14:07 Uhr sind die Excel-Referenzen OK, dort brauchst du lediglich die Passage For Tag = 1 To AnzTage
'...
Next Tag
gegen den Code von daolix im Beitrag vom 2.1.2015 19:39:17 Uhr auszutauschen.
hallo!
erstmal vielen dank für die hilfe an euch beide!
funktioniert Super
@MaggieMay
ich bin nur Hobby pogrammierer weil ich eine eigene lösung für mich brauche dann wirds schwierig
ich hab des ganze jetzt noch erweiter
Public Function CreateExcel_Kalender(jahr As String, bolClose As Boolean, bolGet As Boolean) As Object
Dim Monat As Integer
Dim Tag As Integer
Dim AnzTage As Integer
Dim d As Date
Dim vA()
Set objExcel_Kalender = Excel_New(True)
With objExcel_Kalender
For Monat = 1 To 12
AnzTage = DateSerial(Year(jahr), Monat + 1, 1) - DateSerial(Year(jahr), Monat, 1)
ReDim vA(1 To 2, 1 To AnzTage + 3)
With .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
.Name = Format(DateSerial(1, Monat, 1), "mmm")
.Range("A1:AH2").Interior.ColorIndex = 40
.Range("D1:AH1").NumberFormat = "d"
.Range("D1:AH2").HorizontalAlignment = xlCenter
.Range("D2:AH2").NumberFormat = "ddd"
For Tag = 1 To AnzTage
d = DateSerial(jahr, Monat, Tag)
vA(1, Tag + 3) = d
vA(2, Tag + 3) = d
If Weekday(d) = 1 Or Weekday(d) = 7 Then .Range(.Cells(3, Tag + 3), (.Cells(40, Tag + 3))).Interior.ColorIndex = 15
Next Tag
vA(1, 1) = "ID"
vA(1, 2) = "Veranstaltung"
vA(1, 3) = "Datum"
.Range(.Cells(1, 1), .Cells(2, AnzTage + 3)) = vA()
.Columns("D:AH").ColumnWidth = 3
End With
Next Monat
.Sheets("Tabelle1").Delete
.Sheets("Tabelle2").Delete
.Sheets("Tabelle3").Delete
.SaveAs akt_Verz_Excel_Kalender & "Planung - " & jahr & ".xls"
If bolClose = True Then
.Close
Call ResetExcel
End If
End With
Select Case bolGet
Case True
Set CreateExcel_Kalender = objExcel_Kalender
Case Else
Exit Function
End Select
End Function
um dann das ganz auch noch weiter zu verwenden damit ich alles seperat benutzen kann und ich finde dann ist auch übersichtlicher
allerdings hab ich jetzt die grenze meines wissen glaub ereicht
und scheitere erst mal am schreiben in eine Zelle
ok warscheinlich bin ich auch mit dem auf bau wie ich mir des denke falsch
wenn die sache mal vertig ist sols im groben mal so aus sehn wie auf dem bild
Public Sub Excel_Kalender_Export(jahr As String)
Dim rst As DAO.Recordset
Dim ErsteLeereZeile As Long
Dim objSheet As Object
ErsteLeereZeile = 0
Set objExcel_Kalender_Export = CreateExcel_Kalender(jahr, False, True)
If Not objExcel_Kalender_Export Is Nothing Then
Set rst = CurrentDb.OpenRecordset("qry_rpt_Veranstaltung_Termin_Excel", dbOpenSnapshot)
'
Set objSheet = objExcel_Kalender_Export.Worksheets("Jan")
With objSheet
.Select
ErsteLeereZeile = .Range("A65536").End(xlUp).Row + 2
Do Until rst.EOF
.Cells(1, ErsteLeereZeile).Value = rst.Fields("Veranstaltung_ID")
.Cells(2, ErsteLeereZeile).Value = rst.Fields("Veranstaltung_Name")
.Cells(3, ErsteLeereZeile).Value = rst.Fields("Tag_Monat_Name")
'Hier dann den datumsbereich Schwarz markieren alle werte
' sind in der abfrage vorhanden
' Nächste zeile in Excel
ErsteLeereZeile = ErsteLeereZeile + 1
Loop
End With
End If
End Sub
Gruß Frank
Hallo
ZitatCreateExcel_Kalender(jahr As String, bolClose As Boolean, bolGet As Boolean) As Object
Halte ich unnötigen, unübersichtlichen Eiertanz. Die Aufrufende Funktion (hier Excel_Kalender_Export) sollte die erstellten Objekte terminieren, nicht die aufgerufene.
ZitatDo Until rst.EOF
.Cells(1, ErsteLeereZeile).Value = rst.Fields("Veranstaltung_ID")
.Cells(2, ErsteLeereZeile).Value = rst.Fields("Veranstaltung_Name")
.Cells(3, ErsteLeereZeile).Value = rst.Fields("Tag_Monat_Name")
'Hier dann den datumsbereich Schwarz markieren alle werte
' sind in der abfrage vorhanden
' Nächste zeile in Excel
ErsteLeereZeile = ErsteLeereZeile + 1
Loop
Das ist nicht sehr efficient. Verwende besser CopyFromRecordset, oder, falls es aufgrund deiner Datenstrucktur damit nicht funktioniert, ein 2dimensionales Array welches du erst mit deinen Daten befüllst und dieses dann an Excel übergibst.
Hallo!
ich dachte mir ich kann dann alles so aufrufen wie ich es brauche nur kalender oder füllen mit daten je nach bedarf aber ich versuche zu lernen
ich hab jetz des ganze so weiter gebaut
Public Sub Excel_Kalender_Export(jahr As String)
Dim rst As DAO.Recordset
Dim ErsteLeereZeile As Long
Dim objSheet As Object
Dim intBeginn As Integer
Dim intEnde As Integer
Dim objPfeil As Shape
ErsteLeereZeile = 0
Set objExcel_Kalender_Export = CreateExcel_Kalender(jahr, False, True)
If Not objExcel_Kalender_Export Is Nothing Then
Set rst = CurrentDb.OpenRecordset("qry_rpt_Veranstaltung_Termin_Excel", dbOpenSnapshot)
'
Set objSheet = objExcel_Kalender_Export.Worksheets("Jan")
With objSheet
.Select
ErsteLeereZeile = .Range("A65536").End(xlUp).Row + 2
Do Until rst.EOF
.Cells(ErsteLeereZeile, 1).Value = rst.Fields("Veranstaltung_ID")
.Cells(ErsteLeereZeile, 2).Value = rst.Fields("Veranstaltung_Name")
.Cells(ErsteLeereZeile, 3).Value = rst.Fields("Tag_Monat_Name")
'Wagerechte linie zeichnen
.Shapes.AddConnector(msoConnectorStraight, 1, Cells(ErsteLeereZeile, 1).Top, Cells(ErsteLeereZeile, 35).Left, Cells(ErsteLeereZeile, 1).Top).Select
'Line Von-Bis datumsbereichzeichnen
intBeginn = CInt(Left$(rst.Fields("Veranstaltung_Name"), 3)) + 3
intEnde = CInt(Mid$(rst.Fields("Veranstaltung_Name"), 10, 3)) + 3
Set objPfeil = .Shapes.AddLine(intBeginn, intBeginn, intEnde, intEnde).Name = ErsteLeereZeile
With objPfeil
.Line.BeginArrowheadLength = msoArrowheadLengthMedium
.Line.BeginArrowheadWidth = msoArrowheadNarrow
.Line.BeginArrowheadStyle = msoArrowheadNone
End With
ErsteLeereZeile = ErsteLeereZeile + 1
rst.MoveNext
Loop
End With
End If
End Sub
in der zeile
intBeginn = CInt(Left$(rst.Fields("Veranstaltung_Name"), 3)) + 3
bekomme ich den fehler typ unverträglich ist aber als
Dim intBeginn As Integer
bezeichnet und CInt macht doch den richtigen typ darauds oder
wenn ich im direktfenster eingebe bekomme ich das richtige ergebniss 17 da der 14 in spalte 17 beginnt
msgbox CInt(Left$("14.03 - 16.03", 3)) + 3
ich vermute alerding das ab hier schon das nächste problemm beginnt
ich find in den büchern und im netz wenig daszu und wenn versteh ich es nicht ganz wie ich des unsetzen soll
ich hätte des ganze auch lieber in einem bericht umgesetz aber da wirds ja noch schwerer
Set objPfeil = .Shapes.AddLine(intBeginn, intBeginn, intEnde, intEnde).Name = ErsteLeereZeile
tausche ich
.Cells(1, ErsteLeereZeile).Value = rst.Fields("Veranstaltung_ID")
gegen
.Cells(ErsteLeereZeile, 1).Value = rst.Fields("Veranstaltung_ID")
schreibt es bei mir in der excel tabele untereinander sonst bebeneinander
Gruß Frank
Zitatin der zeile
intBeginn = CInt(Left$(rst.Fields("Veranstaltung_Name"), 3)) + 3
bekomme ich den fehler typ unverträglich ist aber als
Dim intBeginn As Integer
bezeichnet und CInt macht doch den richtigen typ darauds oder
Liegt das ggf daran daß du in
Veranstaltung_Name lt. deinem Bildchen
fdfdfd zu stehen (Was du spalte B zuordnest) und das Datum in
Tag_Monat_Name(Spalte C) ?
evtl. klappt es ja mit
intBeginn = CInt(Left$(rst.Fields("Tag_Monat_Name"), 3)) + 3. Wobei mir hier die 3 nicht ganz klar ist. "2" sollte hier reichen.
Ich selbst würde, wenn ich es so umsetzen würde, mit bedingter Formatierung arbeiten und z.b. bei jedem Veranstaltungstag ein "x" pinseln und auf die Pfeile verzichten.
Hallo! daolix
erstmal danke fürs anschauen
da hab ich wohl vor lauter wald die bäume nicht gesehen :-[
die idee dazu es so zumachen hatte ich durch das klassische kalender withebord magnetstreifen hin papen und kucken
nur drucken geht schneller
das ende der linien stimmt wenn ich das so schreibe aber der anfang nicht ok knifflig wirds bei monats übergreifender darstelung aber des kann ich ja anhand des datums noch auswerten und bis ende des monats gehen und dann die seite wechseln und von 1 bis ende neu zeichnen
.Shapes.AddConnector(msoConnectorStraight, intBeginn, Cells(ErsteLeereZeile, intBeginn).Top, Cells(ErsteLeereZeile, intEnde).Left, Cells(ErsteLeereZeile, intEnde).Top).Select
alle anderen varianten zeichnen stiche kreutz und quer und mit dem setzen des striches in die mitte der zelle komm ich auch nicht zurecht ich finde da auch wenig im netz und im excel vba buch
ich könnte das ganze auch in outlook ausgeben das klappt auch super nur ist das mango dabei das wenn der kalender gedruckt wird er nur eine begrenzte anzahl an terminen angezeigt ich glaug 5 aber 20 untereinander darzustellen geht da auch nicht
ich hab das ganze in ein neues beispiel gepackt vieleicht kennst du ja die lösung :D
Gruß Frank
Hallo
Ich hoffe mal jetzt nicht das die Tabelle der wirklichen Datenstrucktur entspricht.
Anbei deine db, wo jetzt nur die Termine mit der bedingten Formatierung dargestellt werden. Da ich weniger mit Excel mache hab ich keinen Plan von den Shapes.