pb avec un userform

ldexplorer

XLDnaute Junior
Bonjour à tous,

je fais une petite bdd qui va comptabiliser des actes faits pour des usagers d'un centre.

chaque usager a une feuille dans le classeur qui porte son nom. cette feuille est créé par le biais d'une macro qui demande le nom et qui recopie la feuille CE_vierge en remplaçant CE_vierge par le nom de l'usager.

jusque là pas de problème.

J'ai fait un userform qui me permets de rentrer les actes. Il est appellé par le biais d'un bouton qui figure sur la feuille de l'usager (et par conséquent aussi sur la feuille CE_vierge).
Cependant, l'userform ne prend pas en compte le changement d'usager. Il inscrit les actes dans la feuille CE_vierge et pas celle de l'usager.

Je vous mets le bout de code qui me sert à créer la feuille usager :
HTML:
Sub Creation_usager()

Dim Sh As Worksheet
' Macro1 Macro
' Macro enregistrée le 03/11/2006 par j
'
Dim Prompt1   As String
Dim Default1, Left1, Top1, HelpFile1, HelpContextId1, Type1 As Variant
'reponse est fonction du type1
Dim reponse1 As String
'Message
Dim Msg As String, Style As String, Help As String, Ctxt As String, Reponse2   As String
Dim Title1 As String

Application.ScreenUpdating = False
input1:

Prompt1 = " Nom de l'usager  " 'Message à afficher dans la boîte de dialogue
Title1 = " Nouveau nom " 'Titre de la zone de saisie
Default1 = ""

Type1 = 2 '
reponse1 = Application.InputBox(prompt:=Prompt1, Title:=Title1, Default:=Default1, Type:=Type1)
'If reponse1 = False Then Exit Sub
Msg = Title1 & " " & reponse1
Style = vbYesNoCancel + vbCritical + vbDefaultButton2
' Affiche le message pour validation.
Reponse2 = MsgBox(Msg, Style, Title1)
If Reponse2 = vbYes Then GoTo input2
If Reponse2 = vbCancel Then Exit Sub
If Reponse2 = vbNo Then GoTo input1
GoTo input1

input2:
'verification du nom de fichier

Sheets("CE_vierge").Visible = True
For Each Sh In Worksheets
        If Sh.Name = reponse1 Then
            Msg = " La feuille existe déja"
            Style = vbYes + vbCritical
        ' Affiche le message pour validation.
            Reponse2 = MsgBox(Msg, Style, Title1)
            Exit Sub
        End If
Next Sh
If reponse1 <> "" Then
    With Sheets("CE_vierge")
        .Copy After:=Sheets(Sheets.Count)

        ActiveSheet.Name = reponse1 '

        Range("G6") = Date
        Range("B6") = reponse1
        
    End With
End If

trionglet

    Sheets("CE_vierge").Select
    ActiveWindow.SelectedSheets.Visible = False


Application.ScreenUpdating = True
End Sub


ainsi que celui de saisie de l'acte en question :

HTML:
Private Sub BoutAjoutFiche_Click()
'date,heure,duree,intervenant,acte,commentaire
'textdate,textheure,comboduree,combointervenant,co mboactes,textcomment
Dim O As Worksheet

Set O = Sheets("ce_vierge")

ligne = O.Range("B65536").End(xlUp).Row + 1
If ligne < 10 Then ligne = 10

O.Cells(ligne, 2).Value = Me.TextDate
O.Cells(ligne, 3).Value = Me.TextHeure
O.Cells(ligne, 4).Value = Me.ComboDurée
O.Cells(ligne, 5).Value = Me.ComboIntervenant
O.Cells(ligne, 6).Value = Me.ComboActes
O.Cells(ligne, 7).Value = Me.TextCommentaires

Set O = Nothing

IRecap
grisage

End Sub

Private Sub BoutQuitter_Click()
Unload SaisieActe
End Sub


Private Sub ComboDurée_Change()

End Sub

Private Sub UserForm_Initialize()
 
    TextNom.Value = Range("CE_Vierge!B6").Value 'affiche le nom de du chantier extérieur
    ComboIntervenant.RowSource = ("listes!choix_intervenants") 'remplit la combobox intervenant
    ComboActes.RowSource = ("listes!choix_actes") 'remplit la combobox actes
    ComboDurée.RowSource = ("listes!choix_durée") 'remplit la combobox durée
    TextDate.Value = Format(Now(), "dd/mmm/yyyy") 'mets au format jj/mm/aaaa la box date et mets la date du jour par défaut
    
End Sub

Private Sub IRecap()
 
Dim Nom As String 'déclare la variable nom
Dim li As Integer 'déclare la variable li
Dim dest As Range 'déclare la variable dest
 
Nom = ActiveSheet.Range("B6").Value  'définit la variable nom
li = ActiveSheet.Range("B65536").End(xlUp).Row 'définit la variable li
With Sheets("Recap") 'prend en compte l'onglet Recap"
 
    'boucle sur toutes les cellules éditées de la colonne A (en partant de A13)
 
    For Each cel In .Range("A14:A" & .Range("A65536").End(xlUp).Row)
 
        If cel.Value = Nom Then 'condition : si la valeur de la cellule est egale à nom
            Set dest = cel 'définit la variable dest
            GoTo suite 'va à la balise suite
        End If 'fin de la condition
 
    Next cel 'prochaine cellule de la plage
 
If .Range("A14") = "" Then 'condition : si A14 est vide
    Set dest = .Range("A14") 'définit la variable dest ((A14)
Else 'sinon
    Set dest = .Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest (la première ligne vide rencontrée)
End If 'fin de la condition
dest.Value = Nom 'place le nom dans la première cellule vide rencontrée
 
End With
 
suite: 'balise
ActiveSheet.Range(Cells(li, 2), Cells(li, 6)).Copy Destination:=dest.Offset(0, 1) 'copie la ligne
End Sub
Private Sub grisage()
Dim i%
With Sheets("CE_vierge")
    For i = 10 To .Range("B65536").End(xlUp).Row Step 2
        .Range("B" & i & ":J" & i).Interior.ColorIndex = 15
    Next i
    For i = 9 To .Range("B65536").End(xlUp).Row Step 2
        .Range("B" & i & ":J" & i).Interior.ColorIndex = 2
    Next i
End With
End Sub

Je mets en pièce jointe le classeur épuré.

Merci de votre aide précieuse,
Lionel
 

Pièces jointes

  • ce prestations 1.5.zip
    38.7 KB · Affichages: 22

lapix

XLDnaute Occasionnel
Re : pb avec un userform

Bonjour,

J'ai modifié ton fichier et tu trouveras mes modifs entre deux lignes :
'==========================

bonne journee

Ps : tu aurais du garder le meme fil comme cela ceux qui t'ont deja aidé s'y retrouvent car il est rarement facile de reprendre des prog faits par d'autres surtout quand ils se sont etoffés un peu
 

Pièces jointes

  • ce prestations 1.6.zip
    45.9 KB · Affichages: 37
Dernière édition:

ldexplorer

XLDnaute Junior
Re : pb avec un userform

Merci LAPIX,

Tu m'as montré la voie ... .. . ta modif n'etait pas exactement ce qu'il me fallait mais m'a permis de trouver la bonne formule. je n'ai fais qu'une mineure modifi.

Maintenant ca fonctionne,

Merci encore à toi,
Lionel:eek:
 

Discussions similaires

Réponses
2
Affichages
592

Statistiques des forums

Discussions
314 653
Messages
2 111 575
Membres
111 205
dernier inscrit
Adrien25