Discussion :

[sebneb]

Bonsoir tout le monde,

j'ai une petite question à vous poser :

voila je voudrais ajouter une ligne dans une feuille ainsi que le mot à ajouter dans cette ligne puis les classer par ordre alphabétique...

je demande à l'aide d'un inputbox le titre à ajouter... ensuite j'aimerais pouvoir ajouter le titre dans la liste puis trier la liste par ordre alphabétique...

voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Ajouter_un_film()
'
  Dim wk As Workbook
  Dim c As Range ' Resultat de la recherche
  Dim mot As String, sResult As String
  mot = InputBox("saisissez le nom du film à ajouter")
  Dim f As Worksheet 'Feuille dans laquelle effectuer la rechercher
 ' Application.ScreenUpdating = False
  'Ouverture du classeur :
  Set wk = Workbooks.Open("file://localhost/users/sebneb/Desktop/liste DVD/LISTEDVD.xls")
  'Effectue recherche dans 1° feuille du classser
 Selection.EntireRow.Insert
 '   wk.Close True ' Fermetur de classeur sans sauvegarde...
 '  Application.ScreenUpdating = False  'Réactive l'affichage
 
 
'Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
   '     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
 
End Sub

merci d'avance pour votre aide

[sebneb]

bon j'ai avancé dans mon programme :

voici mon nouveau code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Ajouter_un_film()
'
' Ajouter_un_film Macro
' Macro enregistrée le 7/01/2007 par S LT
'
 
'
   Dim wk As Workbook
  Dim c As Range ' Resultat de la recherche
  Dim mot As String, sResult As String
  mot = InputBox("saisissez le nom du film à ajouter")
  Dim f As Worksheet 'Feuille dans laquelle effectuer la rechercher
 ' Application.ScreenUpdating = False
  'Ouverture du classeur :
  Set wk = Workbooks.Open("file://localhost/users/sebneb/Desktop/liste DVD/LISTEDVD.xls")
  'Effectue recherche dans 1° feuille du classser
 'Selection.EntireRow.Insert
 
 Rows(1).Insert Shift:=xlDown
 Range("A1").Select
    ActiveCell.FormulaR1C1 = mot
 '   wk.Close True ' Fermetur de classeur sans sauvegarde...
 '  Application.ScreenUpdating = False  'Réactive l'affichage
 
 Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End Sub

donc là j'ai réussi à créer une nouvelle ligne, à intégrer dans cette nouvelle ligne le titre souhaité puis à ranger par ordre alphabétique la liste...

j'ai un nouveau problème qui se pose : comment faire une comparaison pour éviter de me retrouver avec deux fois le même titre... Si le titre existe déjà retourner un message disant que ce titre fait déjà parti de la liste...

un grand merci d'avance
au passage si vous voyez des rectifications à faire dans mon code pour l'optimiser je suis preneur...

[AlainTech]

Quelque chose dans ce genre-là te conviendrait?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Ajouter_un_film()
'
' Ajouter_un_film Macro
' Macro enregistrée le 7/01/2007 par S LT
'
'
  Dim wk As Workbook
  Dim c As Range ' Resultat de la recherche
  Dim mot As String, sResult As String
  Dim f As Worksheet 'Feuille dans laquelle effectuer la rechercher
  mot = InputBox("saisissez le nom du film à ajouter")
  If Not mot = "" Then
    ' Application.ScreenUpdating = False
    ' Ouverture du classeur :
    Set wk = Workbooks.Open("file://localhost/users/sebneb/Desktop/liste DVD/LISTEDVD.xls")
    'Effectue recherche dans 1° feuille du classser
    Set f = wk.Sheets("LeNomDeTaFeuille")
    Set c = f.Columns(1).Find(mot)
    If c Is Nothing Then
      Rows(1).Insert Shift:=xlDown
      f.[A1].Value = mot
 
      f.Columns(1).Sort Key1:=Range("A1"), Header:=xlGuess, _
             OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Else
      MsgBox ("Ce titre existe déjà")
    End If
  End If
  wk.Close True ' Fermetur de classeur avec sauvegarde...
  ' Application.ScreenUpdating = True  'Réactive l'affichage
End Sub

[sebneb]

Un grand merci... car je peux faire ce que je voulais...