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
| Private Sub cmdEnregistrer()
' Dernière ligne non vide
Dim DernLigne As Long
DernLigne = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
Rows(DernLigne).Select
TextBox1.Enabled = True
If MsgBox("Confirmez-vous l'ajout de ce matériel ?", vbYesNo, "Demande confirmation d'ajout") = vbYes Then
' Répertoire
ActiveCell.Offset(1, 0) = TextBox1.Value
' Détail matériel
ActiveCell.Offset(1, 1) = TextBox2.Value
' Lien fichier
ActiveCell(2, 3).Select
While TextBox3.Value = ""
If TextBox3.Value = "" Then
MsgBox "Cette information est obligatoire.", vbCritical, "Nom du fichier"
TextBox3.SetFocus
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox3.Value
End If
Wend
While TextBox4.Value = ""
If TextBox4.Value = "" Then
MsgBox "Cette information est obligatoire.", vbCritical, "Lien du fichier"
TextBox4.SetFocus
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, Address:=TextBox4.Value
End If
Wend
' Lien Auteur
ActiveCell(1, 2).Select
If TextBox5.Value = "" Then
TextBox5.Value = "Inconnu"
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox5.Value
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox5.Value
End If
If TextBox6.Value = "" Then
TextBox6.Value = "Inconnu"
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox6.Value
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, Address:=TextBox6.Value
End If
' Lien Site
ActiveCell(1, 2).Select
If TextBox7.Value = "" Then
TextBox7.Value = "Inconnu"
TextBox8.SetFocus
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox7.Value
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox7.Value
End If
If TextBox8.Value = "" Then
TextBox8.Value = "Inconnu"
ActiveSheet.Hyperlinks.Add Anchor:=selection, TextToDisplay:=TextBox8.Value
Exit Sub
Else
ActiveSheet.Hyperlinks.Add Anchor:=selection, Address:=TextBox8.Value
End If
Else
Exit Sub
End If
MsgBox "Le nouveau matériel a été enregistré avec succès. Si des champs n'ont pa pu être renseignés, vous pourrez le faire ultérieurement avec le bouton 'Modifier'"
TextBox1.SetFocus
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
End Sub |
Partager