Aide sur un fichier vb masque de saisie

[Résolu]
Signaler
Messages postés
3
Date d'inscription
lundi 9 août 2010
Statut
Membre
Dernière intervention
11 août 2010
-
Messages postés
3
Date d'inscription
lundi 9 août 2010
Statut
Membre
Dernière intervention
11 août 2010
-
Quelqu'un pourrais m'aider sur cette formule car vb de veux pas la prendre en compte.

Je suis débutant et je suis entrain de realise un masque de saisie pour un suivie budgetaire pour des projets

Merci d'avance

[b]' OK Quand_Clic
Sub Ok_Quand_Clic()
With ActiveDialog
PAI = .DropDowns("PAI").Value
H_Base = .EditBoxes("Base UR").Text
H_CUR = .EditBoxes("Coût UR").Text
H_Année = .EditBoxes("Année").Text
Intervenant = .DropDowns("Intervenant").Value
Coût = .OptionButtons("Forfait").Value
Réal = .OptionButtons("Réalisé").Value
Prév = .OptionButtons("Prévisible").Value
Arbi = .OptionButtons("Arbitrage").Value
Enga = .OptionButtons("Engagé").Value
End With
Ci-dessous la formule complete
Option Explicit

Dim PAI
Dim Index_PAI
Dim Intervenant
Dim Index_Intervenant
Dim H_Année
Dim H_Unité
Dim H_Base
Dim H_CUR
Dim Mode
Dim Index_Mode
Dim Porteur
Dim Index_Porteur
Dim Contributeur
Dim Index_Contributeur
Dim Coût
Dim Réal
Dim Arbi
Dim Prop
Dim Prév
Dim Enga


' Supprimer un enregistrement
Sub Supprimer_int()
Dim Réponse
Dim Question
Dim Title
Question = "Voulez-vous supprimer cette enregistrement ?"
Title = "Supprimer enregistrement"
Réponse = MsgBox(Question, 276, Title)
If Réponse = 6 Then
Supprimer_ligne
Else
Range("A1").Select
End If
End Sub
' Supprimer une ligne
Sub Supprimer_ligne()
ActiveCell.EntireRow.Select
Selection.Delete
Range("A1").Select
End Sub
' Saisie d'une intervention
Sub Saisie_int()
With Sheets("Boite")
.EditBoxes.Text = ""

.DropDowns.Value = 1
.Show
End With
End Sub
' Annuler Quand_Clic
Sub Annuler_QuandClic()
Sheets("Base").Activate
Range("A1").Select
End Sub
' Encadrement cellule
Sub Bordure()
ActiveCell.Select
Selection.Borders(xlTop).LineStyle = xlNone
Selection.Borders(xlBottom).LineStyle = xlNone
Selection.Borders(xlLeft).LineStyle = xlNone
Selection.Borders(xlRight).LineStyle = xlNone
Selection.BorderAround Weight:=xlThin
End Sub
' Ajouter une ligne
Sub Ajouter_ligne()
Range("A1").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.EntireRow.Select
Selection.Insert Shift:=xlBottom
ActiveCell.Select
End Sub
' OK Quand_Clic
Sub Ok_Quand_Clic()
With ActiveDialog
PAI = .DropDowns("PAI").Value
H_Base = .EditBoxes("Base UR").Text
H_CUR = .EditBoxes("Coût UR").Text
H_Année = .EditBoxes("Année").Text
Intervenant = .DropDowns("Intervenant").Value
Coût = .OptionButtons("Forfait").Value
Réal = .OptionButtons("Réalisé").Value
Prév = .OptionButtons("Prévisible").Value
Arbi = .OptionButtons("Arbitrage").Value
Enga = .OptionButtons("Engagé").Value
End With
Mise_A_Jour
End Sub
' Mise à jour d'un ajout de données
Sub Mise_A_Jour()
Recherche_PAI
Recherche_Mode
Recherche_Intervenant
Recherche_Porteur
Recherche_Contributeur
Sheets("Base").Activate
Ajouter_ligne
Selection.Value = H_Unité
Bordure
ActiveCell.Offset(0, 1).Select
Selection.Value = H_BaseUR
Bordure
ActiveCell.Offset(0, 1).Select
Selection.Value = H_CoûtUR
Bordure
ActiveCell.Offset(0, 1).Select
Selection.Value = H_Année
Bordure
ActiveCell.Offset(0, 1).Select
Selection.Value = PAI
Bordure
ActiveCell.Offset(0, 1).Select
If Coût = xlOn Then
Selection.Value = "Forfait"
Else
Coût = "Non définie"
End If
Bordure
ActiveCell.Offset(0, 1).Select
If Réalisé = xlOn Then
Selection.Value = "Réalisé"
ElseIf Prévisible = xlOn Then
Selection.Value = "Prévisible"
ElseIf Arbitrage = xlOn Then
Selection.Value = "Arbitrage"
ElseIf Engagé = xlOn Then
Selection.Value = "Engagé"
Else
Selection.Value = "Proposé"
End If
Bordure
ActiveCell.Offset(0, 1).Select
Selection.Value = Intervenant
Bordure
Range("A1").Select
End Sub

' Recherche d'un intervenant
Sub Recherche_Intervenant()
Sheets("Réserve").Activate
Range("B1").Select
ActiveCell.Offset(Index_Intervenant, 0).Select
Intervenant = Selection.Value
End Sub
' Trier par dates
Sub Tri_Date()
Columns("A:H").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("A1").Select
End Sub
' Trier par temps
Sub Tri_Temps()
Columns("A:H").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("A1").Select
End Sub
' Trier par maintenance
Sub Tri_Maintenance()
Columns("A:H").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("A1").Select
End Sub
' Trier par intervenant
Sub Tri_Intervenant()
Columns("A:H").Select
Selection.Sort Key1:=Range("H2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Range("A1").Select
End Sub

2 réponses

Messages postés
1241
Date d'inscription
mardi 10 octobre 2006
Statut
Membre
Dernière intervention
27 août 2013
6
Bonjour,

Et quelle est l'erreur rencontrée, à quelle ligne?
Sans la coloration syntaxique, c'est un peu galère à lire..


L'expérience, c'est une connerie par jour, mais jamais la même..
Messages postés
3
Date d'inscription
lundi 9 août 2010
Statut
Membre
Dernière intervention
11 août 2010

Sur la partie "OK quand Clic"

le message d'erreur est "Erreur d'excution "1004"

PAI = .DropDowns("PAI").Value