stackoom
  简体   繁体   中英

Issue with MS Word VBA User form

 原文  2017-07-11 14:55:55  6   1    vba/ word-vba/ userform

Question

So I've got a document that I am working on, and thought that I had gotten all the code to work...however after running through some tests, I encountered a bug. When I don't select a Primary Facility option, I receive a runtime error 13 mismatch error, and I'm not exactly sure why. Code is as follows: 

    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

The debugger highlights the following as the problem code: 

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

What do I need to adjust so that if a Primary Facility isn't selected, nothing will be populated into the bookmark, and no error message is received? Thanks in advance!

1 answers

solution1
 0 ACCPTED  2017-07-11 15:51:28

Try this: 

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

暂无
暂无

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

Related Question vba ms word table row issue How To Populate Selections From A User Form List Box into Bullets MS-Word-VBA? MS Word vba in MS Access VBA MS-Word legacy form field calculation Retrieve Row of Form Field in MS Word Table using VBA ComboBox word not recognized when using it in VBA, in a form on MS Access Change color of selected form-fields with VBA in MS Word MS Word VBA for formfields VBA User Form issue select wrong sheet MS Word's grammar checker launches with VBA delete all line breaks in MS Access form
Related Tags
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM