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 18:57:07

Re gmarin, Guy,

Oui, j'avais un peu remarqué aussi pour la confusion des interlocuteurs...

En pièce jointe, ton fichier nouvelle version. Le module de code du Userform devient :
Option Explicit
'--------------------------------------------------------------------------
' Auteur    : Didier FOURGEOT (myDearFriend!)  -  www.mdf-xlpages.com
' Date      : 18/10/2009
'--------------------------------------------------------------------------
Private Sub UserForm_Initialize()
Dim maxCol As Integer
Dim C As Byte, i As Byte
    'Détermination du nombre de lieux maxi
    With Sheets("cars")
        maxCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
    End With
    'Chargement des ComboBox correspondantes
    For C = 1 To 5
        For i = 1 To maxCol - 3
            Controls("cboLieu" & C).AddItem i
        Next i
    Next C
End Sub

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 Ctrl As Control
Dim i As Byte, N 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("cboLieu" & i).ListIndex > -1 And Controls("txtLieu" & i).Text <> "" And Controls("txtlien" & i).Text <> "" Then
            N = Controls("cboLieu" & i).ListIndex
            '8 modèles maximum par lieu
            If Sheets("cars").Cells(2, 4 + N) > 7 Then
                MsgBox "Le lieu n°" & N + 1 & " contient déjà 8 modèles !"
                Ok = False
                Exit For
            Else
                Ok = True
            End If
        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 cboLieu1.ListIndex, txtLien1, txtLieu1
            InsereLien cboLieu2.ListIndex, txtLien2, txtLieu2
            InsereLien cboLieu3.ListIndex, txtLien3, txtLieu3
            InsereLien cboLieu4.ListIndex, txtLien4, txtLieu4
            InsereLien cboLieu5.ListIndex, txtLien5, txtLieu5
        End With
        'RAZ formulaire (préparation pour saisie "de masse")
        For Each Ctrl In Me.Controls
            Select Case TypeName(Ctrl)
            Case "TextBox"
                Ctrl.Text = ""
            Case "ComboBox"
                Ctrl.ListIndex = -1
            End Select
        Next Ctrl
    End If
End Sub

Private Sub InsereLien(Id As Integer, Lien As String, Titre As String)
'Insère le lien dans la feuille
Dim R As Range
    If Id < 0 Or Lien = "" Or Titre = "" Then Exit Sub
    With Sheets("cars")
        Set R = .Cells(10, 4 + Id)
        .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

Private Sub btnAnnuler_Click()
    Unload Me
End Sub

De plus, en réponse à :
Citation :
gmarin a écrit : Re,

Pour information, le fichier sur lequel je travaille réellement, et à partir duquel je prépare les exemples pour les adapter une fois retoqués par les compétences du Forum, comprend 4 feuilles et fait 430k. Je ne peux donc pas le télécharger vers le Forum.
Je n'y tiens pas non plus, les données présentes dessus étant "confidentielles".
Ce qui fait que feuille par feuille, je prépare des exemples "similaires à" et ce n'est pas chose facile.
ce qui explique que je ne peux pas exposer une vue d'ensemble sans risquer de me tromper ici ou là, ou d'omettre involontairement des paramètres vitaux pour les personnes qui planchent sur ces exemples.

Si une solution peut se présenter pour contourner cet état de fait, tout en garantissant la confidentialité, je suis à l'écoute.

Gmarin.

Pour moi, l'analyse d'un tel fichier, dans sa globalité, ne rentre plus dans le cadre des objectifs d'un forum de discussions. En tout cas, ce n'est pas dans cette optique que j'ai créé celui d'XLpages.
Par ailleurs, j'ai dans l'idée que ce n'est pas forcément la vue d'un projet entier qui évitera les incompréhensions de celui qui apporte son aide. L'intervenant restera toujours avec un regard "extérieur" et souvent, seul le créateur du dit projet reste à même d'expliquer ses choix de développements.

Cordialement,