我是vba新手，请帮我解码这个400错误，我正在尝试申请多天休假，并从该行和列中获取姓名和日期应用P

Question

我是 vba 新手，请帮我解码这个 400 错误，我正在尝试在选择 PL 后申请休假多天，但它不会从选择单元格中出来，并且显示 400 错误 这是代码

Sub CreateLeaveApplication()

    ' Declare variables
    Dim ws As Worksheet
    Dim selectedRange As String ' String to store user selection (can contain dollar signs)
    Dim selectedCells As Range ' Range object to hold selected cells
    Dim cell As Range
    Dim empName As String
    Dim leaveDetails As String
    Dim outlookApp As Object ' Optional for email (requires references)
    Dim outlookMail As Object ' Optional for email (requires references)
    Dim empRow As Integer
    Dim startDate As String
    Dim endDate As String
    Dim dates As Collection
    Dim temp As Variant
    Dim i As Integer, j As Integer
    Dim empLeaveData As Object
    Dim col As Integer

    ' Set the worksheet (adjust the sheet name if necessary)
    Set ws = ThisWorkbook.Sheets("Leave Planning 2024 - abcd")

    ' Prompt the user to select a range with PL cells (forces user to select a range)
    selectedRange = Application.InputBox("Select the cells with PL (e.g., A1:C10)", Type:=2) ' Type:=2 for xlRangeConstant

    ' Check if a valid range is selected
    If selectedRange = "" Then ' Empty string indicates no selection
        MsgBox "No range selected. Please select a range containing 'PL' cells.", vbExclamation
        Exit Sub ' Exit the subroutine if no range is selected
    End If

    ' Clean the captured string (remove dollar signs if present)
    selectedRange = Replace(selectedRange, "$", "") ' Remove dollar signs before conversion

    ' Convert the cleaned string to range object
    Set selectedCells = ws.Range(selectedRange)

    ' Validate the selection (optional)
    ' You can add code here to check if the selected range is within a specific sheet area

    ' Initialize leave details string and collections
    leaveDetails = ""
    Set dates = New Collection
    Set empLeaveData = CreateObject("Scripting.Dictionary")

    ' Loop through each cell in the selected range
    For Each cell In selectedCells
        If cell.Value = "PL" Then
            ' Find employee name based on row of selected cell
            empRow = cell.Row
            empName = ws.Cells(empRow, 3).Value ' Assuming employee name is in column C

            ' Get the date (column header) based on selected cell's column
            col = cell.Column
            If Not empLeaveData.Exists(empName) Then
                Set empLeaveData(empName) = CreateObject("Scripting.Dictionary")
            End If
            If Not empLeaveData(empName).Exists(ws.Cells(1, col).Value) Then
                empLeaveData(empName).Add ws.Cells(1, col).Value, ws.Cells(1, col).Value
            End If
        End If
    Next cell

    ' Process leave details for each employee
    ' ... rest of your code for processing and displaying leave details ...

End Sub

在选择包含 PL 的单元格后，我尝试了所有操作，但它显示错误 400

Answer 1

如果您需要

InputBox

中的范围，则类型应为

8

，它返回 7Range` 对象。 因此需要进行一些修改，如下所示：

Sub CreateLeaveApplication()

' Declare variables
Dim ws As Worksheet
Dim selectedRange As Range ' MOD here String to store user selection (can contain dollar signs)
Dim selectedCells As Range ' Range object to hold selected cells
Dim cell As Range
Dim empName As String
Dim leaveDetails As String
Dim outlookApp As Object ' Optional for email (requires references)
Dim outlookMail As Object ' Optional for email (requires references)
Dim empRow As Integer
Dim startDate As String
Dim endDate As String
Dim dates As Collection
Dim temp As Variant
Dim i As Integer, j As Integer
Dim empLeaveData As Object
Dim col As Integer

' Set the worksheet (adjust the sheet name if necessary)
Set ws = ThisWorkbook.Sheets("Sheet1") '("Leave Planning 2024 - abcd")

' Prompt the user to select a range with PL cells (forces user to select a range)
Set selectedRange = Application.InputBox("Select the cells with PL (e.g., A1:C10)", Type:=8) ' MOD here type set to 8.   Type:=2 for xlRangeConstant

' Check if a valid range is selected
If selectedRange Is Nothing Then ' MOD here test an object  Empty string indicates no selection
    MsgBox "No range selected. Please select a range containing 'PL' cells.", vbExclamation
    Exit Sub ' Exit the subroutine if no range is selected
End If

' Clean the captured string (remove dollar signs if present)
selectedRangeAddress = Replace(selectedRange.Address, "$", "") ' MOD Get the address as string.   Remove dollar signs before conversion

' Convert the cleaned string to range object
Set selectedCells = ws.Range(selectedRangeAddress) 'MOD change name of variable

' Validate the selection (optional)
' You can add code here to check if the selected range is within a specific sheet area

' Initialize leave details string and collections
leaveDetails = ""
Set dates = New Collection
Set empLeaveData = CreateObject("Scripting.Dictionary")

' Loop through each cell in the selected range
For Each cell In selectedCells
    If cell.value = "PL" Then
        ' Find employee name based on row of selected cell
        empRow = cell.Row
        empName = ws.Cells(empRow, 3).value ' Assuming employee name is in column C

        ' Get the date (column header) based on selected cell's column
        col = cell.Column
        If Not empLeaveData.Exists(empName) Then
            Set empLeaveData(empName) = CreateObject("Scripting.Dictionary")
        End If
        If Not empLeaveData(empName).Exists(ws.Cells(1, col).value) Then
            empLeaveData(empName).Add ws.Cells(1, col).value, ws.Cells(1, col).value
        End If
    End If
Next cell

' Process leave details for each employee
' ... rest of your code for processing and displaying leave details ...
End Sub