Titre du sujet : Re: gestion de l'insertion de lignes et de la saisie sur ces lignes par myDearFriend! le 18/10/2009 03:21:12
Bonsoir gmarin,
Selon mon expérience, la seule façon viable de contrôler une saisie utilisateur, c'est de passer par un Userform.
Ainsi, toute la saisie peut être contrôlée, vérifiée avant même que les données soient déposées sur la feuille.
Tu trouveras en pièce jointe ton classeur avec une façon de mettre en oeuvre ce point de vue.
Le module de code du Userform est le suivant :
Option Explicit
'--------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
' Date : 18/10/2009
'--------------------------------------------------------------------------
Private Sub btnParcourir1_Click()
Parcourir txtLien1
End Sub
Private Sub btnParcourir2_Click()
Parcourir txtLien2
End Sub
Private Sub btnParcourir3_Click()
Parcourir txtLien3
End Sub
Private Sub btnParcourir4_Click()
Parcourir txtLien4
End Sub
Private Sub btnParcourir5_Click()
Parcourir txtLien5
End Sub
Private Sub Parcourir(Ctrl As Control)
Dim Chemin As Variant
Chemin = Application.GetOpenFilename("Fichier image (*.bmp; *.jpg; *.gif; *.png),*.bmp;*.jpg;*.gif;*.png", , "Choisir fichier image...")
If Not Chemin = False Then
Ctrl.Text = Chemin
End If
End Sub
Private Sub btnInserer_Click()
Dim R As Range
Dim i As Byte
Dim Ok As Boolean
'Contrôle la cohérence de la saisie
If txtModele.Text = "" Then Exit Sub
For i = 1 To 5
If Controls("txtLieu" & i).Text <> "" And Controls("txtlien" & i).Text <> "" Then
Ok = True
Exit For
End If
Next i
If Ok Then
With Sheets("cars")
'Créer nouvelle ligne
.Rows("10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Recopier les formules en A et B
.Range(.Cells(9, 1), .Cells(9, 2)).Copy
.Range(.Cells(10, 1), .Cells(10, 2)).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
'Insérer les données
.Cells(10, 3).Value = txtModele
InsereLien .Cells(10, 4), txtLien1, txtLieu1
InsereLien .Cells(10, 5), txtLien2, txtLieu2
InsereLien .Cells(10, 6), txtLien3, txtLieu3
InsereLien .Cells(10, 7), txtLien4, txtLieu4
InsereLien .Cells(10, 8), txtLien5, txtLieu5
End With
End If
End Sub
Private Sub InsereLien(R As Range, Lien As String, Titre As String)
'Insère le lien dans la feuille
If Lien = "" Or Titre = "" Then Exit Sub
With Sheets("cars")
.Hyperlinks.Add Anchor:=R, Address:=Lien
R.Hyperlinks(1).TextToDisplay = Titre
End With
End Sub
Private Sub btnFin_Click()
Dim Plage As Range
Dim L As Long
'Trier la base
Application.ScreenUpdating = False
With Sheets("cars")
L = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Plage = .Range(.Cells(5, 1), .Cells(L, 8))
Plage.Sort Key1:=.Range("C5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.ScreenUpdating = True
'Fermer le formulaire
Unload Me
'Enregistrer sous...
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Par ailleurs, j'ai inclus dans le module de code de l'objet ThisWorkbook une façon de protéger ta feuille de façon un peu particulière : l'objectif et de protéger cette feuille (par mot de passe "cars") des actions utilisateur tout en permettant les traitements par macro sans avoir à enlever cette protection.
L'argument "UserInterfaceOnly" est l'élément qui permet ce type de verrouillage :
DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK :
Private Sub Workbook_Open()
'Protéger la feuille tout en laissant les macros agir sur celle-ci
Sheets("cars").Protect "cars", UserInterfaceOnly:=True
End Sub
En espérant que cette façon de faire te convienne...
Cordialement,
Nb: pour permettre au plus grand nombre l'accès à ton fichier, je l'ai aussi converti pour être exploitable depuis les versions Excel antérieures à 2007.
|