1. Accueil
  2. Question et réponse
  3. Problème avec MS Word VBA Formulaire utilisateur

Problème avec MS Word VBA Formulaire utilisateur

2017-07-11 4 views
0

J'ai donc un document sur lequel je travaille et j'ai pensé que j'avais tout le code pour fonctionner ... Cependant, après avoir effectué quelques tests, j'ai rencontré un bug. Lorsque je ne sélectionne pas une option Primary Facility, je reçois une erreur 13 d'erreur d'exécution, et je ne sais pas exactement pourquoi. Code est la suivante:Problème avec MS Word VBA Formulaire utilisateur

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

Le débogueur met en évidence les éléments suivants comme code de problème:

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

Que dois-je ajuster afin que si une installation primaire n'est pas sélectionnée, rien ne sera peuplé dans le signet, et aucun message d'erreur est reçu? Merci d'avance!

Source

2017-07-11 John Rodgers

Répondre

0

Essayez ceci:

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

Source

2017-07-11 15:51:28

+0

Merci Kostas, qui a résolu le problème! En tant que nouveau venu chez VBA, avez-vous des commentaires sur ce que j'ai fourni? –

+1

Dans la mesure du possible, essayez de décomposer votre code en petits morceaux gérables et utilisez l'instruction 'With ... End With' autant que possible. En outre, vous n'avez pas besoin de déclarer une variable pour chaque signet pour mettre à jour son 'Text'. Voir l'utilisation en réponse. –

 Questions connexes

  • Aucun problème connexe^_^