Rapport de message :*
 

Re: gestion de l'insertion de lignes et de la saisie sur ces lignes

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.