1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
| Option Explicit
Private Sub UserForm_Initialize()
'Récupération du Username dans feuille de données
With ThisWorkbook.Sheets("Données")
Label1.Caption = .Range("RécupUserName").Value
Label4.Caption = .Range("Date").Value
'Label10.Caption = .Range("ChronoMax").Value + 1 'je la met en commentaire car la cellule contient une erreur de lien, je te laisse la réactiver
ComboBox2.Value = .Range("Secteur").Value
End With
End Sub
'Correspond au programme du bouton VALIDER
Private Sub CommandButton1_Click()
Dim L As Integer
Dim Commentaire As String
Dim EstOuvert As Integer 'Toujours une majuscule dans une variable (ça permet de repérer dans le code une variable mal orthographié)
Dim Fich As Workbook
Dim TbxSourceClasseur As Workbook
Dim NewRow As ListRow 'Déclaration d'un objet Row (qui représente une ligne du tableau
'JE/JP option button obligatoire
'Ici autant déclarer xCtrl comme étant un controle (+ un nom explicite, sachnat que xCtrl est souvent utilisé dans les code comme étant une variable de type Integer)
Dim xCtrl As Control, UneOptionAuMoins1 As Boolean
Dim iCtrl As Integer
'Déclaration Mail
Dim MailAd As String
Dim Msg As String
Dim Subj As String
Dim URLto As String
'initialisation des valeurs
Commentaire = TextBox4.Text
UneOptionAuMoins1 = False
'On regarde si une sélection à bien été faite
For Each xCtrl In Frame3.Controls
'UneOptionAuMoins1 = UneOptionAuMoins1 Or xCtrl.Value
If xCtrl.Value Then
UneOptionAuMoins1 = True
'On quitte la boucle, inutile d'aller plus loin
Exit For
End If
Next xCtrl
If Not UneOptionAuMoins1 Then
MsgBox "Veuillez cocher une Entité dans l'onglet Réception !" & vbLf & _
vbLf & "Validation refusée"
Exit Sub
End If
If MsgBox("Etes-vous certain de vouloir INSERER cette Non-Conformité ?", vbYesNo, "Demande de confirmation") = vbYes Then
'Verification si "Tbx source" est ouvert sinon l'ouvrir
EstOuvert = False
For Each Fich In Workbooks
If Fich.Name = "Tbx source.xlsm" Then EstOuvert = True
Next
'Ici remet le code comme tu as besoin, je modifie uniquement pour coller par rapport à l'emplacement de mon fichier
'Ici il faut aussi prendre en compte le fichier ouvert et le pointé via la variable TbxSourceClasseur
If EstOuvert = False Then
Set TbxSourceClasseur = Workbooks.Open(ThisWorkbook.Path & "\Tbx source.xlsm") '("c:\Users\Philippe\SkyDrive\Documents\NC Jone\Tbx source.xlsm")
Else
Set TbxSourceClasseur = Workbooks("Tbx source.xlsm")
End If
'On simplifie l'écriture (attention Feuil3 est le codeName de la feuille pas le nom contenu dans l'onglet sous Excel (voir image liée au poste
'Ici tu changes le nom de ta feuille qui contient le tableau, donc Feuil1 à la place de feuil3 (c'est mieux de les renommer pour que ce soit plus explicite dans le code)
'Tu changes le nom de ton tableau, ici c'est Tableau1 (c'est mieux de les renommer pour que ce soit plus explicite dans le code)
'Tu nas pas précisé de Feuille ici, il faut Classeur.Feuille.ListObject
With TbxSourceClasseur.Sheets("tbx Source").ListObjects("BdD")
'On créee une nouvelle ligne et on la pointe avec NewRow
Set NewRow = .ListRows.Add
'Insertion valeur dans cellules
.ListColumns("NdC").DataBodyRange.Cells(NewRow.Index, 1).Value = TextBox1
.ListColumns("NdP").DataBodyRange.Cells(NewRow.Index, 1).Value = TextBox2
.ListColumns("Désignation").DataBodyRange.Cells(NewRow.Index, 1).Value = TextBox3
.ListColumns("Qté").DataBodyRange.Cells(NewRow.Index, 1).Value = ComboBox1.Value
'Attention à l'orthographe des noms de colonnes
.ListColumns("Seteur").DataBodyRange.Cells(NewRow.Index, 1).Value = ComboBox2.Value
.ListColumns("Défaur").DataBodyRange.Cells(NewRow.Index, 1).Value = ComboBox3.Value
.ListColumns("Emetteur").DataBodyRange.Cells(NewRow.Index, 1).Value = Label1
.ListColumns("Chrono").DataBodyRange.Cells(NewRow.Index, 1).Value = Label10
.ListColumns("Date_E").DataBodyRange.Cells(NewRow.Index, 1).Value = Label4
'Il faut absolument renommer tes composants, ça te permettra une meilleur lecture de ton code
'Ensuite on peut essayer de rendre le code plus léger
'Si il n'y a que deux choix, tu peux faire comme ça (il faut dans ce cas qu'un bouton soit défini à true par défaut)
'Pour ma part jepense que les optionbouton sont fait pour avoir un bouton coché par défaut,
'Si tu ne veux pas de valeur par défaut il faut activer la propriété TripleState de l'option bouton pour que l'utilisateur puisse le passer à l'état non coché (dans ce cas la, il faudra modifier la ligne suivante qui ne fonctionnera plus).
.ListColumns("Entité").DataBodyRange.Cells(NewRow.Index, 1).Value = IIf(OB_JP.Value, "JP", "JE")
'If OB_JP.Value = True Then .ListColumns("Entité").DataBodyRange.Cells(NewRow.Index, 1) = "JP"
'If OB_JE.Value = True Then .ListColumns("Entité").DataBodyRange.Cells(NewRow.Index, 1) = "JE"
If TextBox4 > "" Then .ListColumns("Défaut").DataBodyRange.Cells(NewRow.Index, 1).Comment.Text Text:=Commentaire 'Remplit le commentaire
'Avec plusieurs choix, tu peux faire une boucle
For iCtrl = 1 To 3
If Me.Frame2.Controls("OB_T" & CStr(iCtrl)).Value Then
.ListColumns("MT").DataBodyRange.Cells(NewRow.Index, 1).Value = "T" & iCtrl
Exit For
End If
Next
'If OB_T1.Value = True Then .ListColumns("MT").DataBodyRange.Cells(NewRow.Index, 1) = "T1"
'If OB_T2.Value = True Then .ListColumns("MT").DataBodyRange.Cells(NewRow.Index, 1) = "T2"
'If OB_T3.Value = True Then .ListColumns("MT").DataBodyRange.Cells(NewRow.Index, 1) = "T3"
'Inutile de mettre OB.value = true, le "= true" est sous entendu puisque .value est une valeur boolèenne, donc si .value = true renvoie False, c'est que .value = False et donc autant utiliser directement .value... :) Si c'est pas claire redemande j'expliquerais plus en détail.
.ListColumns("MC").DataBodyRange.Cells(NewRow.Index, 1).Value = IIf(OB_C1.Value, "C1", "C2")
'If OptionButton9.Value = True Then .ListColumns("MC").DataBodyRange.Cells(NewRow.Index, 1) = "C2"
'Je te laisse faire une boucle ici et renommer tes controls
If OB_I1.Value = True Then .ListColumns("MI").DataBodyRange.Cells(NewRow.Index, 1).Value = "I1"
If OB_I2.Value = True Then .ListColumns("MI").DataBodyRange.Cells(NewRow.Index, 1).Value = "I2"
If OptionButton12.Value = True Then .ListColumns("MI").DataBodyRange.Cells(NewRow.Index, 1).Value = "I3"
If OptionButton13.Value = True Then .ListColumns("MI").DataBodyRange.Cells(NewRow.Index, 1).Value = "I4"
If OptionButton14.Value = True Then .ListColumns("MI").DataBodyRange.Cells(NewRow.Index, 1).Value = "I5"
'[...]
'Si tu veux supprimer une ligne
'.ListRows.Item(2).Delete
End With
'Vider cellules feuille "formulaire"
'Toujours préciser le classeur
With ThisWorkbook.Sheets("formulaire")
.Range("A3:e3").ClearContents
.Range("A8:e8").ClearContents
.Range("A14:e14").ClearContents
.Range("A26:e26").ClearContents
'remplissage feuille "formulaire"
'Plutôt que Cells dans un cas comme celui la Range est plus adapté il permet une meilleur lecture du code
'Il est préférable de précisé .Text ou .Caption ou ... ça évite les mauvaise surprise.
.Range("A8") = Label4.Caption
.Cells(8, 2) = TextBox1.Text
.Cells(8, 3) = ComboBox2.Value
.Cells(8, 4) = Label1.Caption
.Cells(8, 5) = TextBox2.Text
.Cells(14, 2) = TextBox3.Text
.Cells(26, 2) = TextBox4.Text
.Cells(3, 5) = Year(Label4.Caption) & "/" & Label10.Caption
MsgBox ("Non-Conformité enregistrée") 'Vous informe la NC est insérée dans votre tableau Excel.
'ça fonctionne ça? de décharger le formulaire qui contient le code qui est en cours d'execution ?
'Unload Me 'Ferme le formulaire
Me.Hide 'cache juste le formulaire
'Commande pour impression
.Visible = 1
.Activate 'Select, Activate fonctionne même si le classeur qui contient la feuille à selectionner n'est pas actif (Select plante dans ce cas)
'previsualisation
'Unload Me 'Tu l'as déjà fait
.PrintPreview
'pour impression directe enlever le ' devant la ligne suivante et le mettre sur la ligne précédente
'.PrintOut
End With
With ThisWorkbook.Sheets("Données")
'Envoi automatique de mail
MailAd = .Range("T1").Value
Subj = .Range("T2").Value
Msg = Msg & .Range("T10").Value
URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg
'ActiveWorkbook.FollowHyperlink Address:=URLto
ThisWorkbook.FollowHyperlink Address:=URLto
ThisWorkbook.Sheets("Formulaire").Visible = 0
'Tu peux utiliser les CodeName des feuille, ici j'ai modifié celui de l'onglet d'accueil, tu peux faire de même pour tes autres feuilles, ça allége le code
F_Accueil.Activate
'ThisWorkbook.Sheets("Acceuil").Select
End With
End If
End Sub |
Partager