Problem mit MS Word VBA Benutzerformular

So habe ich ein Dokument, an dem ich arbeite, und dachte, dass ich den ganzen Code zum Arbeiten bekommen hatte ... aber nachdem ich einige Tests durchlaufen hatte, stieß ich auf einen Fehler. Wenn ich keine Primary Facility-Option auswähle, erhalte ich einen Laufzeitfehler 13 Mismatch-Fehler und ich weiß nicht genau warum. Code ist wie folgt:Problem mit MS Word VBA Benutzerformular

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

Der Debugger hebt die folgenden Optionen als Problemcode:

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

Was muss ich einstellen müssen, so dass, wenn eine primäre Einrichtung nicht aktiviert ist, wird nichts sein besiedelte in das Lesezeichen, und keine Fehlermeldung wird empfangen? Danke im Voraus!

Quelle

2017-07-11 John Rodgers

Versuchen Sie folgendes:

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

Quelle

2017-07-11 15:51:28

Dank Kostas, dass es gelöst! Als jemand, der neu in VBA ist, haben Sie ein Feedback bezüglich was ich zur Verfügung gestellt habe? –

Wenn möglich, versuchen Sie, Ihren Code in kleine überschaubare Blöcke zu zerlegen und verwenden Sie die Anweisung "Mit ... Ende mit" so viel wie möglich. Außerdem müssen Sie nicht für jedes Lesezeichen eine Variable deklarieren, um den 'Text' zu aktualisieren. Siehe Verwendung in Antwort. –

Problem mit MS Word VBA Benutzerformular

Antwort

Verwandte Themen