Anzeige
Archiv - Navigation
1656to1660
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Objektvariable oder With-Blockvariable nicht festg

Objektvariable oder With-Blockvariable nicht festg
26.11.2018 17:58:33
Knight
Hallo VBA-Community,
ich habe mal eine Frage bzgl. eines Fehlers, was mir der VBA Editor wirft. Die dazugehörigen Excel-Datei habe ich mit angefügt. Das Passwort zum öffnen der Datei ist "qwe123". Hier zu finden https://www.herber.de/bbs/user/125661.xlsm
Das makro soll folgendes tun:
- Eine mail soll generiert werden
- In der Mail soll eine Tabelle erstellt mit folgenden Headern:
"Datum" - "ESK" - ESK backup"
- Bei ESK soll aus der dem worksheet "Schichtplanung-Neu" die Tage, in denen "ESK" oder "Normal+NB" steht ausgefüllt werden.
Bei ESK backup alle Tage mit dem ESKB im Feld.
Unten soll eine Tabelle mit den Namen des Mitarbeiters, seine Telefonnummer und email adresse abgebildet werden. Diese Information wird aus dem Worksheet Telefonliste bezogen.
Ein screenshot wie es aussehen soll, kann hier gefunden werden https://www.herber.de/bbs/user/125662.jpg
Mein Code sieht folgendermaßen aus:
Sub CreateMail()
'password handling
Dim password As Variant
password = Application.InputBox("Enter Password", "Password Protected")
Select Case password
Case Is = False
'do nothing, no password is set
Case Is "email"
'wrong password
MsgBox "Passwort nicht korrekt."
Case Else
'execute the makro
executeMail
End Select
End Sub Sub executeMail()
'On Error Resume Next
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Set NewMail = olApp.CreateItem(olMailItem)
'declare variables for rowNumbers, weekNumber ans shiftUser
Dim weekNum As Long, searchDateColumnNum As Long, calculator As Long
Dim shiftRowNum As Long, additionalShiftRowNum As Long, lateNightShiftRowNum As Long, earlyNightShiftRowNum As Long
Dim shiftUser As String, lateNightShiftUser As String, earlyNightShiftUser As String, additionalShiftUser As String
Dim dayDate As Date, startDate As Date, endDate As Date
dayDate = Date
'get user input for number of days
customerRequest:
dayCount = Application.InputBox("Enter the number of days to evaluate", "Day Count", 8)
If dayCount = False Then GoTo cancelButton
Select Case dayCount
Case 1 To 15
'correct number, no need for a new number
Case Else
'execute the makro
MsgBox "Please enter a number between 1 and 15"
GoTo customerRequest 'go back to customer questions for the number of days
End Select
'Date evaluation and weekdays
Dim currentDate As Date
currentDate = Date
weekStartDate = DateAdd("d", -Weekday(currentDate) + 2, currentDate) '+2 offset weekstart sunday and current day
weekEndDate = DateAdd("d", dayCount - 1, weekStartDate)
searchDate = weekStartDate
weekDays = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag", "Montag")
dayDate = weekStartDate
'Define and set Worksheet dimension
Dim ShiftSheet As Worksheet, phoneSheet As Worksheet
Set ShiftSheet = Worksheets("Schichtplanung-Neu")
Set phoneSheet = Worksheets("Telefonliste")
'strings for normal output and strings for table and its styles
TableStyle = "style=""border: 1px solid black; padding: 5px;"""
tableHeaderTagStart = ""
tableHeaderTagEnd = ""
tableCellTagStart = ""
tableCellTagEnd = ""
linebreak = "
"
Dim nightShiftArray() As String
ReDim nightShiftArray(dayCount, 2) As String
Dim searchStrings(4) As String
searchStrings(0) = "ESK"
searchStrings(1) = "ESK b"
searchStrings(2) = "Normal+NB"
searchDateColumnNum = ShiftSheet.Rows(5).Find(what:=Format(searchDate, "DD.MM.YYYY"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Dim emptyRow As Boolean
emptyRow = False
Dim counter As Long
counter = 0
'phoneList for phone numbers
phoneString = "
"
Dim lCount As Long
Set rFoundCell = Range("A1")
shiftRowNum = 1
For I = 1 To UBound(nightShiftArray)
If emptyRow Then counter = counter - 1 Else counter = counter
For J = 1 To UBound(searchStrings)
Dim rowFound As Range, shiftTerm As String
If searchStrings(J - 1) "" Then shiftTerm = searchStrings(J - 1) Else shiftTerm = "Can't be found"
'Set rowFound = ShiftSheet.Columns(searchDateColumnNum).Find(what:=shiftTerm, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
Set rowFound = Range("A1")
For lCount = 1 To WorksheetFunction.CountIf(Columns(searchDateColumnNum), shiftTerm)
Set rowFound = ShiftSheet.Columns(searchDateColumnNum).Find(what:=shiftTerm, After:=Cells(shiftRowNum, searchDateColumnNum), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'error handling due to not found rows
If rowFound Is Nothing Then
shiftRowNum = 0
Else
shiftRowNum = ShiftSheet.Columns(searchDateColumnNum).Find(what:=shiftTerm, After:=Cells(shiftRowNum, searchDateColumnNum), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
End If
If shiftRowNum 0 Then shiftUser = ShiftSheet.Cells(shiftRowNum, 1).Value Else shiftUser = "-"
If searchStrings(J - 1) "ESK b" And shiftUser "-" Then
If nightShiftArray(I, 1) = "" Then nightShiftArray(I, 1) = shiftUser Else nightShiftArray(I, 1) = nightShiftArray(I, 1) & linebreak & shiftUser
End If
If searchStrings(J - 1) = "ESK b" Then
If nightShiftArray(I, 2) = "" Then nightShiftArray(I, 2) = shiftUser Else nightShiftArray(I, 2) = nightShiftArray(I, 2) & linebreak & shiftUser
End If
If shiftUser "-" Then
alreadyInList = InStr(phoneString, shiftUser)
If alreadyInList = 0 Then phoneString = phoneString & findPhoneNumber(phoneList, shiftUser, phoneSheet) & ""
End If
Next lCount
Next J
'build scaffolding of tbale cells
nightShiftArray(I, 0) = tableCellTagStart & weekDays(counter) & ", den " & Format(dayDate, "DD.MM.YYYY") & tableCellTagEnd
If weekDays(counter) = "Montag" And nightShiftArray(I, 1) = "" And nightShiftArray(I, 2) = tableCellTagStart & "-" & tableCellTagEnd Then
nightShiftArray(I, 0) = ""
nightShiftArray(I, 1) = ""
nightShiftArray(I, 2) = ""
emptyRow = True
Else
'check if any employee is assigned to night shift
tempString = nightShiftArray(I, 1)
If tempString = "" Then tempString = "-"
nightShiftArray(I, 1) = tableCellTagStart
nightShiftArray(I, 1) = nightShiftArray(I, 1) & tempString
nightShiftArray(I, 1) = nightShiftArray(I, 1) & tableCellTagEnd
tempString = nightShiftArray(I, 2)
If tempString = "" Then tempString = "-"
nightShiftArray(I, 2) = tableCellTagStart
nightShiftArray(I, 2) = nightShiftArray(I, 2) & tempString
nightShiftArray(I, 2) = nightShiftArray(I, 2) & tableCellTagEnd
'only for display purpose
dayDate = DateAdd("d", 1, dayDate)
emptyRow = False
End If
'get next column
searchDateColumnNum = searchDateColumnNum + 1
counter = counter + 1
Next I
phoneString = phoneString & "
"
'Mail content Table Output
strhtml = "

Hallo zusammen," & "
" & "
"
strhtml = strhtml & "Bereitschaftsabdeckung vom " & Format(weekStartDate, "DD.MM.YYYY") & " bis " & Format(weekEndDate, "DD.MM.YYYY") & ".
"
strhtml = strhtml & "Hinweis: Die Bereitschaftsabdeckung gilt immer von 06:00 Uhr bis 06:00 Uhr des jeweiligen Tages." & "

"
strhtml = strhtml & ""
strhtml = strhtml & tableHeaderTagStart & "Datum" & tableHeaderTagEnd
strhtml = strhtml & tableHeaderTagStart & "ESK " & tableHeaderTagEnd
strhtml = strhtml & tableHeaderTagStart & "ESK backup" & tableHeaderTagEnd
For I = 1 To UBound(nightShiftArray)
strhtml = strhtml & ""
For J = 0 To 2
strhtml = strhtml & nightShiftArray(I, J)
Next J
strhtml = strhtml & ""
continue:
Next I
strhtml = strhtml & "
" & "
" & "
"
'Generate mail with subject, receiver and set content
With NewMail
.Getinspector
.Importance = 2
.Subject = "[BEREITSCHAFTSABDECKUNG]von " & Format(weekStartDate, "DD.MM.YYYY") & " bis " & Format(weekEndDate, "DD.MM.YYYY") & " "
.To = "test@mail.com"
.HTMLbody = strhtml & phoneString & .HTMLbody
.display
End With
cancelButton:
'do nothing
End Sub
Private Function findPhoneNumber(phoneList, employeeName, phoneSheet) As String
Dim FoundRow As Range
Dim FindRowNumber As Long
findPhoneNumber = " "
With phoneSheet
Set FoundRow = .Range("A:A").Find(what:=employeeName, LookIn:=xlValues)
FindRowNumber = FoundRow.Row
findPhoneNumber = findPhoneNumber & FoundRow & "" & .Cells(FindRowNumber, 2).Value & "" & .Cells(FindRowNumber, 3).Value & " "
End With
End Function

Der Debugger meldet beim Ausführen "Objektvariable oder With-Blockvariable nicht festgelegt" und markiert den folgenden Code-Snippet:
searchDateColumnNum = ShiftSheet.Rows(5).Find(what:=Format(searchDate, "DD.MM.YYYY"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Könntet ihr mir vielleicht hier weiterhelfen?

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 18:29:47
Daniel
Hi
Datum mit .Find suchen ist nicht so ganz Trivial, weil hier die Problematiken der unterschiedlichen Datumschreibweisen berücksichtigt werden müssen.
probier mal die Datumssuche nur mit what:=SearchDate falls searchDate vom Type Date ist, oder ggf mit dem Datum im amerikantischen Format, weil Excel und VBA englisch mit einander reden:
what:=Format(searchDate, "MM\/DD\/YYYY")
wenn die Datumswerte nur in einer Zeile oder Spalte gesucht werden, kann es auch einfacher sein, die Zeilen- oder Spaltennummer mit Application.Match zu bestimmen und nach dem Ganzzahlwert des Datums zu suchen:
searchDateColumnNum = Worksheetfunction.Match(Clng(searchDate), ShiftSheet.Rows(5), 0)
sollte man einen Kalender haben mit lückenlos aufsteigenden Datumswerten, dann könnte man die Spaltennummer auch berechnen nach dem Schema:
searchDateColumnNum = searchDate - Datum_in_der_ersten_Spalte + Spaltennummer_erste_Datumsspalte
Gruß Daniel
Anzeige
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 18:38:29
Knight
Hallo Daniel,
Vielen Dank für deine schnelle Antwort. Ich habe nun den code von dir verwendet und hinzugefügt:
searchDateColumnNum = WorksheetFunction.Match(CLng(searchDate), ShiftSheet.Rows(2), 0)
Hier habe ich bei Rows die 2, weil das Datum aus der zweiten Zeile entnommen werden soll. Allerdings kommt jetzt die Fehlermeldung erneut, jedoch wird jetzt die Zeile:
FindRowNumber = FoundRow.Row gelb markiert
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 18:49:14
Daniel
Hi
naja, dann hast du wohl einen falschen employeeNamen angegeben, der nicht in der Liste vorkommt.
wenn man mit .Find arbeitet und die Fundstelle einer Range-Variablen zuweist, so wie du des gemacht hast, dann kann man diesen Fall relativ einfach abprüfen um den Fehlerabbruch zu vermeiden:
set foundRow = ...Find(what:=Suchbegriff)
if foundRow is nothing then
hier der Code für den Fall dass der Suchbegriff nicht gefunden werden konnte
else
hier den Code für den Fall, wenn der Suchbegriff vorhanden ist
end if
Gruß Daniel
Anzeige
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 19:24:50
Knight
Hallo,
Hast du dir mal die excel datei angeschaut? Wo genau soll denn der Code hin?
Hier ist der Code, der die Tabelle mit den Namen der Mitarbeiter und Kontaktdaten ausgibt:
Set rowFound = ShiftSheet.Columns(searchDateColumnNum).Find(what:=shiftTerm, After:=Cells(shiftRowNum, searchDateColumnNum), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
'error handling due to not found rows
If rowFound Is Nothing Then
shiftRowNum = 0
Else
shiftRowNum = ShiftSheet.Columns(searchDateColumnNum).Find(what:=shiftTerm, After:=Cells(shiftRowNum, searchDateColumnNum), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
End If
If shiftRowNum 0 Then shiftUser = ShiftSheet.Cells(shiftRowNum, 1).Value Else shiftUser = "-"
If searchStrings(J - 1) "ESKB" And shiftUser "-" Then
If nightShiftArray(I, 1) = "" Then nightShiftArray(I, 1) = shiftUser Else nightShiftArray(I, 1) = nightShiftArray(I, 1) & linebreak & shiftUser
End If
If searchStrings(J - 1) = "ESKB" Then
If nightShiftArray(I, 2) = "" Then nightShiftArray(I, 2) = shiftUser Else nightShiftArray(I, 2) = nightShiftArray(I, 2) & linebreak & shiftUser
End If
If shiftUser "-" Then
alreadyInList = InStr(phoneString, shiftUser)
If alreadyInList = 0 Then phoneString = phoneString & findPhoneNumber(phoneList, shiftUser, phoneSheet) & ""
End If
Und hier die Funktion:
Private Function findPhoneNumber(phoneList, employeeName, phoneSheet) As String
Dim FoundRow As Range
Dim FindRowNumber As Long
findPhoneNumber = " "
With phoneSheet
Set FoundRow = .Range("A:A").Find(what:=employeeName, LookIn:=xlValues)
FindRowNumber = FoundRow.Row
findPhoneNumber = findPhoneNumber & FoundRow & "" & .Cells(FindRowNumber, 2).Value & "" & .Cells(FindRowNumber, 3).Value & " "
End With
End Function

AW: Objektvariable oder With-Blockvariable nicht festg
Daniel

nö, hab ich mir nicht angeschaut.
ist mir jetzt unbezahlt auch zu aufwendig, soviel Code nur theoretsich durchzugehen.
ich habe mich auf die Zeilen beschränkt, die du als Fehler verursachend gemeldet hast.
wo der Code hin muss?
im Prinzip nach jedem Set RangeVariable = Zellbereich.Find(what:=Suchbegriff...)
bei dem es vorkommen kann, dass der Suchbegriff nicht vorhanden ist.
Gruß Daniel
AW: Objektvariable oder With-Blockvariable nicht festg
Knight

Hi,
ich danke dir vielmals. Hab es soweit umgesetzt bekommen. :-)
Anzeige
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 19:34:18
Daniel
nö, hab ich mir nicht angeschaut.
ist mir jetzt unbezahlt auch zu aufwendig, soviel Code nur theoretsich durchzugehen.
ich habe mich auf die Zeilen beschränkt, die du als Fehler verursachend gemeldet hast.
wo der Code hin muss?
im Prinzip nach jedem Set RangeVariable = Zellbereich.Find(what:=Suchbegriff...)
bei dem es vorkommen kann, dass der Suchbegriff nicht vorhanden ist.
Gruß Daniel
AW: Objektvariable oder With-Blockvariable nicht festg
26.11.2018 19:58:11
Knight
Hi,
ich danke dir vielmals. Hab es soweit umgesetzt bekommen. :-)

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige