时间戳

首页 > 解决方案 > 如果多个范围内的值为空，则为 Msgbox

excel - 如果多个范围内的值为空，则为 Msgbox

问题描述

下面的代码（当 F 列中有数据时）创建一个文件夹，将其超链接并从 Excel 数据创建一个 Word 文档，完成后会出现一个 msgbox - "Licence(s) and/ or folder(s) created, please delete text from column F."。

当 F 列中没有数据时，不会发生这种情况，并且 msbox 会显示"No licence(s) to create - please enter text in column F for the appropriate licence(s) you wish to create."。我想得到它，以便它在它为空白时以及 N 列中的相应单元格时出现，但无论我尝试什么，我都无法让它正常工作。

它应该只"Licence(s) and/ or folder(s) created, please delete text from column F."在 N 和 F 列中有文本时显示。

Sub CreateLicenceFull()

Dim objWord
Dim objDoc
Dim objRange
Dim dirName As String
        On Error Resume Next
Dim Foldername As String

   r = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 5 To r
        With Cells(i, 5)

         If .Value = "Mobile Plant" And Cells(i, 6) <> "" And Cells(i,14) <>"" Then
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 4), Address:="\\Wbcphfil01.wbc.lan\dts\Groups\Operational_Services\opserv_group\Enforcement\NRSWA\Licences\Mobile Plant\Applications 2019-20\" & Cells(i, 4) & " (" & Cells(i, 12) & ")", TextToDisplay:=.Value
         dirName = Cells(4, i).Values
         MkDir ("\\Wbcphfil01.wbc.lan\dts\Groups\Operational_Services\opserv_group\Enforcement\NRSWA\Licences\Mobile Plant\Applications 2019-20\" & Cells(i, 4) & " (" & Cells(i, 12) & ")")
         Call Shell("explorer.exe" & " " & "\\Wbcphfil01.wbc.lan\dts\Groups\Operational_Services\opserv_group\Enforcement\NRSWA\Licences\Mobile Plant\Applications 2019-20\" & Cells(i, 4) & " (" & Cells(i, 12) & ")", vbNormalFocus)

        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        Set objDoc = objWord.Documents.Add(Template:="\\Wbcphfil01.wbc.lan\dts\Groups\Operational_Services\opserv_group\Enforcement\NRSWA\Licences\Mobile Plant\Mobile Plant Licence.docx", NewTemplate:=False, DocumentType:=0)

    Set objRange = objDoc.Bookmarks("LicenceNo").Range
    objRange.InsertAfter Cells(i, 4)

    Set objRange = objDoc.Bookmarks("Date").Range
    objRange.InsertAfter Cells(i, 29)

    Set objRange = objDoc.Bookmarks("Company").Range
    objRange.InsertAfter Cells(i, 7)

    Set objRange = objDoc.Bookmarks("Address").Range
    objRange.InsertAfter Cells(i, 8)

    Set objRange = objDoc.Bookmarks("Location").Range
    objRange.InsertAfter Cells(i, 13)

    Set objRange = objDoc.Bookmarks("Location2").Range
    objRange.InsertAfter Cells(i, 12)

    Set objRange = objDoc.Bookmarks("From").Range
    objRange.InsertAfter Cells(i, 18)

    Set objRange = objDoc.Bookmarks("To").Range
    objRange.InsertAfter Cells(i, 19)

    Set objRange = objDoc.Bookmarks("Date2").Range
    objRange.InsertAfter Cells(i, 29)

    Set objRange = objDoc.Bookmarks("Name").Range
    objRange.InsertAfter Cells(i, 53)

    objWord.Visible = True
    objDoc.SaveAs ("\\Wbcphfil01.wbc.lan\dts\Groups\Operational_Services\opserv_group\Enforcement\NRSWA\Licences\Mobile Plant\Applications 2019-20\" & Cells(i, 4) & " (" & Cells(i, 12) & ")\" & Cells(i, 4) & " (" & Cells(i, 12) & ")")


MsgBox Cells(i, 4) & " - Licence(s) and/ or folder(s) created, please delete text from column F."
        End If

        If .Value = "Mobile Plant" And Cells(i, 6) <> "" And Cells(i, 14) = "" Then
        MsgBox "No licence(s) to create - please enter the application date in column N for the appropriate licence(s) you wish to create."

        End If
End With

next i

If WorksheetFunction.CountA(Range("F5:F1000")) = 0 Then
        MsgBox "No licence(s) to create - please enter text in column F for the appropriate licence(s) you wish to create."

    End If

    End Sub

标签： excelvba

解决方案

  • 我认为你应该在行之间的循环内移动下面的代码End With，Next i 如果你想在每一行都得到一个 msgbox。

  • 虽然在每一行都获得一个 Msgbox 会非常混乱。如果您有 1000 行数据，则表示 1000 个 Msgbox 弹出窗口。

If Len(Range("F" & i)) = 0 And Len(Range("N" & i)) = 0 Then
    MsgBox "No licence(s) to create - please enter text in column F for the appropriate licence(s) you wish to create."
Else
    MsgBox "Licence(s) and/ or folder(s) created, please delete text from column F."
End If

推荐阅读