1004 - Ошибка диапазона метода объекта листа

Question

У меня небольшая проблема, я написал один макрос для Excel, но у меня есть одна ошибка, решение которой я не знаю.Вот код:

Dim poleInput As Variant

Public Function HasContent(text_box As Object) As Boolean
    HasContent = (Len(Trim(text_box.Value)) > 0)
End Function

Sub TextBox1_Change()
        poleInput = TextBox1.Text
End Sub

Sub CommandButton1_Click()
    If HasContent(TextBox1) Then
        MsgBox "Po¾e je prázne, pridaj nejake údaje!"
    Else
        'MsgBox (poleInput)
        AddAppointments (poleInput)
        AddAppointmentsAfterThreeMonths (poleInput)
        MsgBox "Pripomienka úspešne poslatá!"
    End If
End Sub

Sub AddAppointments(pole As String)
'Update by Extendoffice 20180608
    Dim I As Long
    Dim xRg As Range
    Dim xOutApp As Object
    Dim xOutItem As Object

    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = Range(pole)

    For I = 1 To xRg.Rows.Count
        Set xOutItem = xOutApp.createitem(1)
        Debug.Print xRg.Cells(I, 1).Value
        xOutItem.Subject = "Posla mail " & xRg.Cells(I, 2).Value
        xOutItem.Location = "Office"
        xOutItem.Start = xRg.Cells(I, 1).Value & " 11:00"
        xOutItem.End = xRg.Cells(I, 1).Value & " 17:00"
        xOutItem.BusyStatus = 2
        xOutItem.ReminderSet = True
        xOutItem.ReminderMinutesBeforeStart = "15"
        xOutItem.Body = "Posla mail zamestnancovy " & xRg.Cells(I, 2).Value
        xOutItem.Save
        Set xOutItem = Nothing
    Next
    Set xOutApp = Nothing
End Sub

Sub AddAppointmentsAfterThreeMonths(pole As String)
'Update by Extendoffice 20180608
    Dim I As Long
    Dim xRg As Range
    Dim xOutApp As Object
    Dim xOutItem As Object

    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = Range(pole)

    For I = 1 To xRg.Rows.Count
        Set xOutItem = xOutApp.createitem(1)
        Debug.Print xRg.Cells(I, 1).Value
        xOutItem.Subject = "Posla pripomienku " & xRg.Cells(I, 2).Value
        xOutItem.Location = "Office"
        xOutItem.Start = DateAdd("m", 3, xRg.Cells(I, 1)) & " 11:00"
        xOutItem.End = DateAdd("m", 3, xRg.Cells(I, 1)) & " 17:00"
        xOutItem.BusyStatus = 2
        xOutItem.ReminderSet = True
        xOutItem.ReminderMinutesBeforeStart = "15"
        xOutItem.Body = "Posla pripomienku zamestnancovy " & xRg.Cells(I, 2).Value
        xOutItem.Save
        Set xOutItem = Nothing
    Next
    Set xOutApp = Nothing
End Sub

В этой строке отображается сообщение об ошибке:

Set xRg = Range(pole)

Я не понимаю, почему возникает проблема с отображением проблемы, это просто - нужно только проанализировать строку в диапазоне и получить код вверхи работает, но почему-то все идет не так, так что если кто-то из вас знает решение этой проблемы, пожалуйста, напишите мне решение,

Спасибо заранее.

Answer 1

Строка ниже

If HasContent(TextBox1) Then

совпадает с

If HasContent(TextBox1) = True Then

Это не то, что вам нужно.Вы хотите избежать пустого текстового поля.Измените строку

If HasContent(TextBox1) Then

на

If HasContent(TextBox1) = False Then

или

If Not HasContent(TextBox1) Then

Пример

If Not HasContent(TextBox1) Then '<~~ Blank
    MsgBox "Blank"
Else '<~~ Not Blank
   MsgBox "Not Blank"
End If

Таким образом poleInput не будетбыть пустым, и вы не получите сообщение об ошибке из-за пустого ввода.