MS Word VBA 用户表单问题

Question

所以我有一个我正在处理的文档，我认为我已经得到了所有的代码......但是在运行通过一些测试之后，我遇到了一个错误。当我没有 select 主设施选项时，我收到运行时错误 13 不匹配错误，我不确定为什么。代码如下：

    Private Sub cbR1AccessSite_Change()
    If cbR1AccessSite.Value = "" Then
    Exit Sub
    cbPrimaryFacility.Clear
    lbAF.Clear
End If

If cbR1AccessSite.Value = "CARE" Then
    lbPrimaryFacility.Clear
    lbPrimaryFacility.AddItem "BACC"
    lbPrimaryFacility.AddItem "BAOK"
    lbPrimaryFacility.AddItem "BGMI 
    lbPrimaryFacility.AddItem "BHTN"
    lbPrimaryFacility.AddItem "BMAL"
    lbPrimaryFacility.AddItem "BOLE"
    lbPrimaryFacility.AddItem "BOMC"
    lbPrimaryFacility.AddItem "BPHC"
    lbPrimaryFacility.AddItem "BPMI"
    lbPrimaryFacility.AddItem "BRMI"
    lbPrimaryFacility.AddItem "BTAL"
    lbPrimaryFacility.AddItem "BTMI"
    lbPrimaryFacility.AddItem "CHAL"
    lbPrimaryFacility.AddItem "DCTX"
    lbPrimaryFacility.AddItem "DPTX"
    lbPrimaryFacility.AddItem "DSTX"
    lbPrimaryFacility.AddItem "EDTX"
    lbPrimaryFacility.AddItem "EHIN"
    lbPrimaryFacility.AddItem "ESAL"
    lbPrimaryFacility.AddItem "GRMC"
    lbPrimaryFacility.AddItem "HLTX"
    lbPrimaryFacility.AddItem "HMTX"
    lbPrimaryFacility.AddItem "JAKS"
    lbPrimaryFacility.AddItem "JBKS"
    lbPrimaryFacility.AddItem "JPOK"
    lbPrimaryFacility.AddItem "LLNJ"
    lbPrimaryFacility.AddItem "LMNJ"
    lbPrimaryFacility.AddItem "MCOK"
    lbPrimaryFacility.AddItem "MCTX"
    lbPrimaryFacility.AddItem "MCWI"
    lbPrimaryFacility.AddItem "MHKS"
    lbPrimaryFacility.AddItem "MTTN"
    lbPrimaryFacility.AddItem "NHOK"
    lbPrimaryFacility.AddItem "OCWI"
    lbPrimaryFacility.AddItem "OHOK"
    lbPrimaryFacility.AddItem "PHAL"                        lbPrimaryFacility.AddItem "PHDC"
    lbPrimaryFacility.AddItem "PNTX"
    lbPrimaryFacility.AddItem "RHKS"
    lbPrimaryFacility.AddItem "RPTN"
    lbPrimaryFacility.AddItem "SCAL"
    lbPrimaryFacility.AddItem "SCFL"
    lbPrimaryFacility.AddItem "SFNJ"
    lbPrimaryFacility.AddItem "SHWI"
    lbPrimaryFacility.AddItem "SJMA"
    lbPrimaryFacility.AddItem "SJMC"
    lbPrimaryFacility.AddItem "SJNS"
    lbPrimaryFacility.AddItem "SJOK"
    lbPrimaryFacility.AddItem "SJOK"
    lbPrimaryFacility.AddItem "SJPK"
    lbPrimaryFacility.AddItem "SJPR"
    lbPrimaryFacility.AddItem "SJRD"
    lbPrimaryFacility.AddItem "SLFL"
    lbPrimaryFacility.AddItem "SMMC"
    lbPrimaryFacility.AddItem "SMSH"
    lbPrimaryFacility.AddItem "SNTX"
    lbPrimaryFacility.AddItem "SPOK"
    lbPrimaryFacility.AddItem "SSTX"
    lbPrimaryFacility.AddItem "STAH"
    lbPrimaryFacility.AddItem "STKS"
    lbPrimaryFacility.AddItem "STTN"
    lbPrimaryFacility.AddItem "SVFL"
    lbPrimaryFacility.AddItem "TAWA"
    lbPrimaryFacility.AddItem "UBTX"
    lbPrimaryFacility.AddItem "VFKS"
    lbPrimaryFacility.AddItem "VJKS"
    lbPrimaryFacility.AddItem "VPKS"
    lbPrimaryFacility.AddItem "WHKS"
    lbPrimaryFacility.AddItem "WMTX"
    lbAF.Clear
    lbAF.AddItem "All CARE Sites"
    lbAF.AddItem "All Austin"
    lbAF.AddItem "All Beaumont"
    lbAF.AddItem "All Birmingham"
    lbAF.AddItem "All Borgess"
    lbAF.AddItem "All CHE New Jersey"
    lbAF.AddItem "All Elkhart"
    lbAF.AddItem "All Genesys"
    lbAF.AddItem "All Jacksonville"
    lbAF.AddItem "All Milwaukee"
    lbAF.AddItem "All Nashville"
    lbAF.AddItem "All Providence AL/Mobile"
    lbAF.AddItem "All Providence DC"
    lbAF.AddItem "All St Anthony's"
    lbAF.AddItem "All St Johns Michigan"
    lbAF.AddItem "All St Joseph's"
    lbAF.AddItem "All St Mary's"
    lbAF.AddItem "All Standish"
    lbAF.AddItem "All Tulsa"
    lbAF.AddItem "All Waco"
    lbAF.AddItem "All Wichita "

End If

If cbR1AccessSite.Value = "IMH" Then
    lbPrimaryFacility.Clear
    lbPrimaryFacility.AddItem "A116"
    lbPrimaryFacility.AddItem "A118"
    lbPrimaryFacility.AddItem "A120"
    lbPrimaryFacility.AddItem "A122"
    lbPrimaryFacility.AddItem "A124"
    lbPrimaryFacility.AddItem "A125"
    lbPrimaryFacility.AddItem "A126"
    lbPrimaryFacility.AddItem "A127"
    lbPrimaryFacility.AddItem "A130"
    lbPrimaryFacility.AddItem "A132"
    lbPrimaryFacility.AddItem "A134"
    lbPrimaryFacility.AddItem "A138"
    lbPrimaryFacility.AddItem "A139"
    lbPrimaryFacility.AddItem "A140"
    lbPrimaryFacility.AddItem "A142"
    lbPrimaryFacility.AddItem "A143"
    lbPrimaryFacility.AddItem "A144"
    lbPrimaryFacility.AddItem "A146"
    lbPrimaryFacility.AddItem "A148"
    lbPrimaryFacility.AddItem "A152"
    lbPrimaryFacility.AddItem "A154"
    lbPrimaryFacility.AddItem "A270"
    lbPrimaryFacility.AddItem "A364"
    lbPrimaryFacility.AddItem "A365"
    lbPrimaryFacility.AddItem "A366"
    lbPrimaryFacility.AddItem "A400"
    lbAF.Clear
    lbAF.AddItem "All IMH"
    lbAF.AddItem "A116"
    lbAF.AddItem "A118"
    lbAF.AddItem "A120"
    lbAF.AddItem "A122"
    lbAF.AddItem "A124"
    lbAF.AddItem "A125"
    lbAF.AddItem "A126"
    lbAF.AddItem "A127"
    lbAF.AddItem "A128"
    lbAF.AddItem "A130"
    lbAF.AddItem "A132"
    lbAF.AddItem "A134"
    lbAF.AddItem "A138"
    lbAF.AddItem "A139"
    lbAF.AddItem "A140"
    lbAF.AddItem "A142"
    lbAF.AddItem "A143"
    lbAF.AddItem "A144"
    lbAF.AddItem "A146"
    lbAF.AddItem "A148"
    lbAF.AddItem "A152"
    lbAF.AddItem "A154"
    lbAF.AddItem "A270"
    lbAF.AddItem "A364"
    lbAF.AddItem "A365"
    lbAF.AddItem "A366"
    lbAF.AddItem "A400"

End If
End Sub

Private Sub lbPrimaryFacility_Change()

If lbPrimaryFacility.Value = "" Then
    Exit Sub
    R1AccessRequest.tbAuthorizedApprovers.Text = ""
End If

If (lbPrimaryFacility.Value = "BACC" Or lbPrimaryFacility.Value = "BOMC" Or lbPrimaryFacility.Value = "BOLE" Or lbPrimaryFacility.Value = "BPHC") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "espohn"
End If

If (lbPrimaryFacility.Value = "BAOK" Or lbPrimaryFacility.Value = "JPOK" Or lbPrimaryFacility.Value = "MCOK" Or lbPrimaryFacility.Value = "NHOK" Or lbPrimaryFacility.Value = "OHOK" Or lbPrimaryFacility.Value = "SJOK" Or lbPrimaryFacility.Value = "SPOK") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "RHamil" & vbCr & "BCates"
End If

If (lbPrimaryFacility.Value = "BGMI" Or lbPrimaryFacility.Value = "BPMI" Or lbPrimaryFacility.Value = "BRMI" Or lbPrimaryFacility.Value = "BTMI") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "ddooley" & vbCr & "Bcutter" & vbCr & "bstocker" & vbCr & "mnaylor"
End If

If (lbPrimaryFacility.Value = "BHTN" Or lbPrimaryFacility.Value = "MTTN" Or lbPrimaryFacility.Value = "RPTN" Or lbPrimaryFacility.Value = "STTN") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "tsnyder" & vbCr & "lblanchette" & vbCr & "IChidester" & vbCr & "kpaillere" & vbCr & "CAnderson6"
End If

If (lbPrimaryFacility.Value = "BMAL" Or lbPrimaryFacility.Value = "BTAL" Or lbPrimaryFacility.Value = "CHAL" Or lbPrimaryFacility.Value = "ESAL" Or lbPrimaryFacility.Value = "SCAL") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "mallred" & vbCr & "cpoole" & vbCr & "jsmith5"
End If

If (lbPrimaryFacility.Value = "DCTX" Or lbPrimaryFacility.Value = "DSTX" Or lbPrimaryFacility.Value = "EDTX" Or lbPrimaryFacility.Value = "HLTX" Or lbPrimaryFacility.Value = "HMTX" Or lbPrimaryFacility.Value = "MCTX" Or lbPrimaryFacility.Value = "SNTX" Or lbPrimaryFacility.Value = "SSTX" Or lbPrimaryFacility.Value = "UBTX" Or lbPrimaryFacility.Value = "WMTX") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "tmerritt" & vbCr & "KMurar" & vbCr & "SHanlon" & vbCr & "MYandell" & vbCr & "Norma Miller" & vbCr & "SAlvarado"
End If

If (lbPrimaryFacility.Value = "DPTX" Or lbPrimaryFacility.Value = "PNTX") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "jvanzandt"
End If

If (lbPrimaryFacility.Value = "EHIN" Or lbPrimaryFacility.Value = "STAH") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "AGasaway1" & vbCr & "MSoto"
End If

If (lbPrimaryFacility.Value = "GRMC" Or lbPrimaryFacility.Value = "SMMC" Or lbPrimaryFacility.Value = "SMSH" Or lbPrimaryFacility.Value = "TAWA") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "jperlberg" & vbCr & "NKeyes" & vbCr & "eswinson"
End If

If (lbPrimaryFacility.Value = "JAKS" Or lbPrimaryFacility.Value = "JBKS" Or lbPrimaryFacility.Value = "MHKS" Or lbPrimaryFacility.Value = "RHKS" Or lbPrimaryFacility.Value = "STKS" Or lbPrimaryFacility.Value = "VFKS" Or lbPrimaryFacility.Value = "VJKS" Or lbPrimaryFacility.Value = "VPKS" Or lbPrimaryFacility.Value = "WHKS") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "JVanLiew1" & vbCr & "NKetchum" & vbCr & "NThompson1" & vbCr & "Shelia Hale"
End If

If (lbPrimaryFacility.Value = "LLNJ" Or lbPrimaryFacility.Value = "LMNJ" Or lbPrimaryFacility.Value = "SFNJ") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "jblum" & vbCr & "adimemmo"
End If

If (lbPrimaryFacility.Value = "MCWI" Or lbPrimaryFacility.Value = "OCWI" Or lbPrimaryFacility.Value = "SHWI") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "JMalnar1" & vbCr & "skresse"
End If

If (lbPrimaryFacility.Value = "PHAL") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "ogray1"
End If

If (lbPrimaryFacility.Value = "PHDC") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "EMorud"
End If

If (lbPrimaryFacility.Value = "SCFL" Or lbPrimaryFacility.Value = "SLFL" Or lbPrimaryFacility.Value = "SVFL") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "TBauler" & vbCr & "jblum" & vbCr & "alewis1"
End If

If (lbPrimaryFacility.Value = "SJMA" Or lbPrimaryFacility.Value = "SJMC" Or lbPrimaryFacility.Value = "SJNS" Or lbPrimaryFacility.Value = "SJOK" Or lbPrimaryFacility.Value = "SJPK" Or lbPrimaryFacility.Value = "SJPR" Or lbPrimaryFacility.Value = "SJRD") Then
    R1AccessRequest.tbAuthorizedApprovers.Text = "jeustis" & vbCr & "TDeCarlo" & vbCr & "tcheladyn" & vbCr & "SHermann" & vbCr & "TMcCarthy" & vbCr & "ejohnson" & vbCr & "BCarten" & vbCr & "ADudic"
End If

If (lbPrimaryFacility.Value = "A116" Or lbPrimaryFacility.Value = "A118" Or lbPrimaryFacility.Value = "A120" Or lbPrimaryFacility.Value = "A122" Or lbPrimaryFacility.Value = "A124" Or lbPrimaryFacility.Value = "A125" Or lbPrimaryFacility.Value = "A126" Or lbPrimaryFacility.Value = "A127" Or lbPrimaryFacility.Value = "A128") Then
R1AccessRequest.tbAuthorizedApprovers.Text = "jbrownawell" & vbCr & "jdiaz" & vbCr & "RTroksa" & vbCr & "JJorgensen" & vbCr & "BHeaton" & vbCr & "SQuist" & vbCr & "DaJackson" & vbCr & "KHakanen"
End If

If (lbPrimaryFacility.Value = "A130" Or lbPrimaryFacility.Value = "A132" Or lbPrimaryFacility.Value = "A134" Or lbPrimaryFacility.Value = "A138" Or lbPrimaryFacility.Value = "A139" Or lbPrimaryFacility.Value = "A140") Then
R1AccessRequest.tbAuthorizedApprovers.Text = "jbrownawell" & vbCr & "jdiaz" & vbCr & "RTroksa" & vbCr & "JJorgensen" & vbCr & "BHeaton" & vbCr & "SQuist" & vbCr & "DaJackson" & vbCr & "KHakanen"
End If

If (lbPrimaryFacility.Value = "A142" Or lbPrimaryFacility.Value = "A143" Or lbPrimaryFacility.Value = "A144" Or lbPrimaryFacility.Value = "A146" Or lbPrimaryFacility.Value = "A148" Or lbPrimaryFacility.Value = "A152" Or lbPrimaryFacility.Value = "A154" Or lbPrimaryFacility.Value = "A270" Or lbPrimaryFacility.Value = "A364" Or lbPrimaryFacility.Value = "A365" Or lbPrimaryFacility.Value = "A366" Or lbPrimaryFacility.Value = "A400") Then
R1AccessRequest.tbAuthorizedApprovers.Text = "jbrownawell" & vbCr & "jdiaz" & vbCr & "RTroksa" & vbCr & "JJorgensen" & vbCr & "BHeaton" & vbCr & "SQuist" & vbCr & "DaJackson" & vbCr & "KHakanen"
End If

End Sub

Private Sub UserForm_Initialize()
With cbRequestPurpose
    .AddItem "New User"
    .AddItem "Existing User Access Update"
    .AddItem "Reactivation of a Disabled User"
End With

With cbR1AccessSite
    .AddItem "CARE"
    .AddItem "IMH"
End With

With cbJobRole
    .AddItem "CBO"
    .AddItem "CBO Supervisor/CBO Manager"
    .AddItem "Customer Service"
    .AddItem "Director FE"
    .AddItem "ED Registrar"
    .AddItem "ePARS Responder"
    .AddItem "Financial Counselor"
    .AddItem "Lead/Supervisor/Manager/ Patient Access Manager"
    .AddItem "Middle "
    .AddItem "R1Decision Followup"
    .AddItem "R1Decision Manager"
    .AddItem "R1Decision Rep - Billing"
    .AddItem "Registrar / Patient Access Representative"
    .AddItem "Registrar w/ Global"
    .AddItem "Shared Service - BSO Billing  Manager"
    .AddItem "Shared Service - BSO Billing User (India)"
    .AddItem "Shared Service - BSO F/U Manager (Write Off)"
    .AddItem "Shared Service - BSO Follow-Up Day User"
    .AddItem "Shared Service - BSO FollowUp Manager"
    .AddItem "Shared Service - BSO Follow-Up Night User"
    .AddItem "Shared Service - CBO Billing Manager"
    .AddItem "Shared Service - CBO Billing User (US)"
    .AddItem "Shared Service - CBO F/U Manager (WriteOff)"
    .AddItem "Shared Service - CBO Follow-Up Manager"
    .AddItem "Shared Service - CBO Follow-Up User"
    .AddItem "Shared Service - Quality User"
    .AddItem "Training"
End With

End Sub

Private Sub cbOK_Click()
    Dim aRequestPurpose
    Set aRequestPurpose = ActiveDocument.Bookmarks("aRequestPurpose").Range
    aRequestPurpose.Text = Me.cbRequestPurpose.Value

    Dim cR1AccessSite
    Set cR1AccessSite = ActiveDocument.Bookmarks("cR1AccessSite").Range
    cR1AccessSite.Text = Me.cbR1AccessSite.Value

    Dim dUserFirstName
    Set dUserFirstName = ActiveDocument.Bookmarks("dUserFirstName").Range
    dUserFirstName.Text = Me.tbUserFirstName.Value

    Dim eUserLastName
    Set eUserLastName = ActiveDocument.Bookmarks("eUserLastName").Range
    eUserLastName.Text = Me.tbUserLastName.Value

    Dim fUserEmail
    Set fUserEmail = ActiveDocument.Bookmarks("fUserEmail").Range
    fUserEmail.Text = Me.tbUserEmail.Value

    Dim gUserHostID
    Set gUserHostID = ActiveDocument.Bookmarks("gUserHostID").Range
    gUserHostID.Text = Me.tbUserHostID.Value

    Dim hR1AccessUsername
    Set hR1AccessUsername = ActiveDocument.Bookmarks("hR1AccessUsername").Range
    hR1AccessUsername.Text = Me.tbR1AccessUsername.Value



Dim iPrimaryFacility
        Set iPrimaryFacility = ActiveDocument.Bookmarks("iPrimaryFacility").Range
        iPrimaryFacility.Text = Me.lbPrimaryFacility.Value


    Dim SelectedTexts As String
    Dim Index As Integer

    For Index = 0 To lbAF.ListCount - 1
        If lbAF.Selected(Index) Then
            SelectedTexts = SelectedTexts & lbAF.List(Index) & vbCr
        End If
    Next Index
        ActiveDocument.Bookmarks("jAdditionalFacilities").Range.Text = SelectedTexts


    Dim kJobRole
    Set kJobRole = ActiveDocument.Bookmarks("kJobRole").Range
    kJobRole.Text = Me.cbJobRole.Value

    Dim lAuthorizedApprovers
    Set lAuthorizedApprovers = ActiveDocument.Bookmarks("lAuthorizedApprovers").Range
    lAuthorizedApprovers.Text = Me.tbAuthorizedApprovers.Value

    Dim mNotes
    Set mNotes = ActiveDocument.Bookmarks("mNotes").Range
    mNotes.Text = Me.tbNotes.Value

    Me.Repaint
    R1AccessRequest.Hide

End Sub

调试器突出显示以下问题代码：

Dim iPrimaryFacility
        Set iPrimaryFacility = ActiveDocument.Bookmarks("iPrimaryFacility").Range
        iPrimaryFacility.Text = Me.lbPrimaryFacility.Value

我需要进行哪些调整，以便在未 select 编辑主要设施时，书签中不会填充任何内容，也不会收到错误消息？提前致谢！

Answer 1

试试这个：

With Me.lbPrimaryFacility
    If Not IsNull(.Value) Then
        ActiveDocument.Bookmarks("iPrimaryFacility").Range.Text = .Value
    End If
End With

MS Word VBA 用户表单问题

Issue with MS Word VBA User form

vba

ms-word

userform