Sujet Précédent Sujet Suivant

Automatiser les actions

Résolu
cs_Vincent58 Messages postés 4 Date d'inscription vendredi 17 juin 2011 Statut Membre Dernière intervention 22 juin 2011 - 17 juin 2011 à 18:08
cs_Vincent58 Messages postés 4 Date d'inscription vendredi 17 juin 2011 Statut Membre Dernière intervention 22 juin 2011 - 22 juin 2011 à 18:40
Bonjour à tous,

Tout nouveau venu sur le forum, j'ai déjà pu trouver pas mal d'informations grâce a vous et je vous en remercie! Aujourd'hui je viens vous voir car fraîchement débutant en vba sur excel 2007, je dois constituer une base de donnée concurrentielle qui dois être la plus claire possible pour ceux qui devront l’utiliser.
A cet effet, j’aurais quelques questions à vous poser car mes codes ne marchent pas, ou quand ils marchent, sont tellement rafistolés qu’ils pèteront au moindre écart… Je vous remercie par avance car je sais que cela ne se fait pas vraiment de vous demander de faire le travail à ma place, mais après tout, cela me permet d’apprendre tout autant.

Je m’explique. J’ai une base concurrentielle d’environs 35 feuilles. Ce que je veux obtenir, c’est une base où les premières feuilles sont fixes, et les suivantes sont du nom des concurrents, et où je puisse ajouter des concurrents. J’ai ainsi arrangé manuellement : « 1. Instructions », « 2. Overview », etc puis les concurrents « A », « B », « C », etc.
Jusqu'à présent, ma macro « Add_competitor » crée une nouvelle feuille à la suite de « 4. Example » avec un msgbox demandant de mettre le nom du concurrent :
Sub Add_competitor()
Sheets("4.Example").Select
Sheets("4.Example").Copy Before:=Sheets(6)
Sheets("4.Example (2)").Select
Sheets("4.Example (2)").Name = "Name of new competitor"
MsgBox ("Please input the name of the new competitor on the sheet")
Range("B3").Select
End Sub

Ce que je voudrais, c’est à vrai dire que la macro fasse cela :
1. Lors de la création de la nouvelle feuille, la msgbox me demande de nommer la cellule B3 et que je puisse taper le nom dans la msgbox directement (on l’appelera NOM ).
2. Le nom sera toujours situé en cellule B3. Il faudrait que le NOM en B3 soit aussi le même pour le nom de la feuille (ce que je n’ai pas trouvé, même en création automatique..) et aussi que cela soit répercuté dans « 2.Overview » à la suite des autres concurrents.
3. On a donc NOM : en sheets(« NOM ») et en sheets(« NOM »).Range(« B3 »), et en sheets(« 2.Overview ») en colonne A en dernière position. Ce qu’il me faut désormais, c’est faire un lien hypertexte entre les deux feuilles.
4. Enfin, trier les feuilles de A a Z

Merci par avance à tous ceux qui pourront m'aider!

7 réponses

Réponse 1 / 7
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
20 juin 2011 à 14:17
L'erreur se situe à
"=VLOOKUP(R2C,Reponse!C1:C2,2,FALSE)"
je ne comprends pas très bien ce que représente R2C, il faudrait un peu plus de précision.
En attendant je t'ai fait cela pendant le WE sur ta demande créer des liens hypertexte et trier les onglets.
Dans un nouveau classeur tu mets un UserForm avec 5 Button avec ce code pour voir le fonctionnement: 
Option Explicit
Private Sub CommandButton1_Click()
NouvelleFeuille
End Sub
Private Sub CommandButton2_Click()
Triercolonne_croissant
End Sub
Private Sub CommandButton3_Click()
Triercolonne_decroissant
End Sub
Private Sub CommandButton4_Click()
TrierFeuilles_croissant
End Sub
Private Sub CommandButton5_Click()
TrierFeuilles_decroissant
End Sub
Sub NouvelleFeuille()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
Dim supp
Dim ligne As Integer
Dim a As Integer
LeString = ":\/?*[]"

Do
    BonNom = True
    Reponse = InputBox("Quel nom désirez-vous donner à la" _
        + vbCrLf + "nouvelle feuille de votre classeur?", _
        "Baptisez votre feuille ", MonNom)
    If Reponse <> "" Then
       'Vérifier que le nom n'existe pas déjà...
        For a = 1 To ActiveWorkbook.Worksheets.Count
            If UCase(Reponse) = UCase(Worksheets(a).Name) Then
                supp = MsgBox( _
                    "Vous possédez une feuille portant déjà ce nom," _
                    + vbCrLf + vbCrLf + _
                    "Désirez-vous la remplacer?.", vbYesNo + vbOKOnly, _
                    "Nom existant déjà")
                If supp = vbYes Then
                    Application.DisplayAlerts = False
                    Worksheets(Reponse).Delete
                    Application.DisplayAlerts = True
                    Exit For
                Else
                    BonNom = False
                    MonNom = Reponse
                    Exit For
                End If
            End If
        Next
        
        'Vérifier que le nombre de caractères du nom ne dépassent 31...
        If Len(Reponse) > 31 Then
            MsgBox "Le nombre de caractères (" & _
                Len(Reponse) & ") de votre nom dépasse" _
                + vbCrLf + " celui permis (31) par excel.", _
                vbCritical + vbInformation, "Nom trop long"
            BonNom = False
            MonNom = Reponse
        End If
        
        'Vérifier l'emploi de caractères interdits...dans le nom
        For a = 1 To Len(LeString)
            If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
                MsgBox "Les caractères suivants:  " & _
                LeString & "  sont interdits" _
                + vbCrLf + "dans le nom d'une feuille.", _
                vbCritical + vbOKOnly, "Caractère interdit"
                BonNom = False
                MonNom = Reponse
                Exit For
            End If
        Next
    Else
        Exit Sub
    End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Sh.Name = Reponse
 
 'sélection interface
Worksheets("Feuil1").Select
'dernière ligne feuille active, colonne A
  ligne = Cells(Cells.Rows.Count, "A").End(xlUp).Row

'lien hypertexte vers nouvelle feuille
 Range("A" & ligne).Select 'sélection dernière ligne
 If Range("A1").Value = "" Then 'pour la 1ère utilisation
 ActiveCell.FormulaR1C1 = Reponse 'Nom de la feuille
Else
    ActiveCell.Offset(1, 0).Select 'sélection cellule en dessous
    ActiveCell.FormulaR1C1 = Reponse 'Nom de la feuille
    End If
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        Reponse & "!A1", TextToDisplay:=Reponse
    
    'sélection nouvelle feuille
    Worksheets(Reponse).Select
   'lien hypertexte vers l'interface
    Range("A1").Select
    ActiveCell.FormulaR1C1 = Reponse  'Nom de la feuille
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
       "Feuil1!A1", TextToDisplay:="Retour " & "Feuil1"
    End Sub
Sub Triercolonne_croissant()
  'sélection interface
Worksheets("Feuil1").Select
 Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub
Sub Triercolonne_decroissant()
 'sélection interface
Worksheets("Feuil1").Select
Columns("A:A").Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End Sub
Sub TrierFeuilles_croissant()
'attention : feuil11 est trié entre feuil1 et feuil2
Dim I As Integer, J As Integer, K As Integer
    Application.ScreenUpdating = False
    For I = 1 To Sheets.Count
        J = I
        For K = I + 1 To Sheets.Count
            If Sheets(K).Name < Sheets(J).Name Then J = K
        Next K
        If J <> I Then Sheets(J).Move Sheets(I)
    Next I
End Sub
Sub TrierFeuilles_decroissant()
'attention : feuil11 est trié entre feuil1 et feuil2
Dim I As Integer, J As Integer, K As Integer
    Application.ScreenUpdating = False
    For I = 1 To Sheets.Count
        J = I
        For K = I + 1 To Sheets.Count
            If Sheets(K).Name > Sheets(J).Name Then J = K
        Next K
        If J <> I Then Sheets(J).Move Sheets(I)
    Next I
End Sub


Ensuite tu n'auras plus qu'a l'adapter en changeant le nom de l'interface et la cellule A1
3
Réponse 2 / 7
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
18 juin 2011 à 07:56
Bonjour,
Regarde ceci, cela te permettra d'avancer:

http://frederic.sigonneau.free.fr/code/Feuilles/AjouterEtNommerFeuilleClasseur.txt

@+Le Pivert
0
Réponse 3 / 7
cs_Vincent58 Messages postés 4 Date d'inscription vendredi 17 juin 2011 Statut Membre Dernière intervention 22 juin 2011
20 juin 2011 à 12:25
Merci énormément Le Pivert!

Grâce à toi j'ai pu bien avancer. J'ai réussi à compléter le code que tu m'a transmis avec ce qu'il me fallait en plus, touefois, je reste juste bloqué au moment de faire une RECHERCHEV, car cela ne me trouve pas le nom de l'onglet en mettant (Reponse)... Je cherche à mettre dans l'onglet "2.Overview" tout ce qui sera tapé dans le nouvel onglet (Reponse), mais ça bloque lorsque la fonction cherche la base.

Une idée?


[i]Sheets("2.Overview").Select
Range("A60").Select
ActiveCell.FormulaR1C1 = Reponse
'Recherche V et etendre la selection

Range("B60").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C,Reponse!C1:C2,2,FALSE)"
Range("B60").Select
selection.AutoFill Destination:=Range("B60:CX60"), Type:=xlFillDefault
Range("B60:CX60").Select/i
0
Réponse 4 / 7
cs_Vincent58 Messages postés 4 Date d'inscription vendredi 17 juin 2011 Statut Membre Dernière intervention 22 juin 2011
20 juin 2011 à 15:22
Merci pour les informations supplémentaires! J'avais trouvé une méthode pour le tri des onglets que j'ai rajouté avec succès à ton code. L'hypertexte, pour l'instant ne marche pas mais c'est parce que tout n'est pas encore complet. J'essaie de tout mettre dans la même sub pour ne pas être gêné par le "Reponse".

D'après Google, R2C correspondrait aux rangées et aux colonnes. Cependant, dans les autres lignes où j'avais tapé à la main la fonction, ça me donnait la formule suivante: "= RECHERCHEV(B$2; nom_onglet !$A:$B;2;FAUX)", celle que je veux étendre de B$2 à CX$2.

Je te mets ici le code en entier à son état actuel, peut être que ce te sera plus clair. La partie à la fin en vert est celle où je suis bloqué..

Encore merci 

Sub Add_competitor()

Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString  = ":\/?*[]"

Do
    BonNom = True
    Reponse = InputBox("Please write here the name of the competitor", _
        "Name of the sheet", MonNom)
    If Reponse <> "" Then
       'Vérifier que le nom n'existe pas déjà...
        For a = 1 To ActiveWorkbook.Worksheets.Count
            If UCase(Reponse) = UCase(Worksheets(a).Name) Then
                supp = MsgBox( _
                    "Competitor already exists (or this sheet already exists)" _
                    + vbCrLf + vbCrLf + _
                    "Would you like to replace it?.", vbYesNo + vbOKOnly, _
                    "Name already existing")
                If supp = vbYes Then
                    Application.DisplayAlerts = False
                    Worksheets(Reponse).Delete
                    Application.DisplayAlerts = True
                    Exit For
                Else
                    BonNom = False
                    MonNom = Reponse
                    Exit For
                End If
            End If
        Next
        
        'Vérifier que le nombre de caractères du nom ne dépassent 31...
        If Len(Reponse) > 31 Then
            MsgBox "Le nombre de caractères (" & _
                Len(Reponse) & ") de votre nom dépasse" _
                + vbCrLf + " celui permis (31) par excel.", _
                vbCritical + vbInformation, "Name too long"
            BonNom = False
            MonNom = Reponse
        End If
        
        'Vérifier l'emploi de caractères interdits...dans le nom
        For a = 1 To Len(LeString)
            If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
                MsgBox "Les caractères suivants:  " & _
                LeString & "  sont interdits" _
                + vbCrLf + "dans le nom d'une feuille.", _
                vbCritical + vbOKOnly, "Forbidden caracter"
                BonNom = False
                MonNom = Reponse
                Exit For
            End If
        Next
    Else
        Exit Sub
    End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sh.Name = Reponse

' Tier les feuilles de A a Z

    Dim Boucle As Integer, Compteur As Integer

    For Boucle = 1 To Sheets.Count
        If Sheets(Boucle).Visible = True Then
           For Compteur = 1 To (Boucle - 1)
               If Sheets(Compteur).Visible = True Then
                    If (UCase(Sheets(Boucle).Name) < UCase(Sheets(Compteur).Name)) Then
                        Sheets(Boucle).Move before:=Sheets(Compteur)
                        Exit For
                    End If
               End If
           Next Compteur
        End If
    Next Boucle
    

'
' Get info from 4.Example, copy paste it all in the new sheet
'
    Sheets("4.Example").Select
    Cells.Select
    selection.Copy
    Range("A1").Select
    Sheets(Reponse).Select
    ActiveSheet.Paste
    Range("A1").Select
    Rows("1:1").RowHeight = 91.5
    Sheets("4.Example").Select
Application.CutCopyMode = False
Sheets(Reponse).Select
Range("A1").Select
ActiveWindow.Zoom = 90

' Name Cell B3 (company name)
'
    Range("B3").FormulaR1C1 = Reponse
    With Range("B3").Characters(Start:=1, Length:=7).Font
        .Name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
' Nommer la cellule dans overview

Sheets("2.Overview").Select
Range("A60").Select 'Mettre le nom de la nouvelle compagnie en bas d'une liste avec assez d'espace entre celles existantes et A60
ActiveCell.FormulaR1C1 = Reponse


'Recherche V et etendre la selection

'  Range("B60").Select
 '   ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C,Reponse!C1:C2,2,FALSE)"
  '  Range("B60").Select
   ' selection.AutoFill Destination:=Range("B60:CX60"), Type:=xlFillDefault
    'Range("B60:CX60").Select

'Sub Tri_Overview()
'
' Tri_Overview Macro
'

'
   ' Sheets("2.Overview").Select
    'Range("A3:CX60").Select
    'ActiveWorkbook.Worksheets("2.Overview").Sort.SortFields.Clear
    'ActiveWorkbook.Worksheets("2.Overview").Sort.SortFields.Add Key:=Range("A3") _
     '   , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    'With ActiveWorkbook.Worksheets("2.Overview").Sort
    '    .SetRange Range("A4:CX60")
     '   .Header = xlNo
      '  .MatchCase = False
       ' .Orientation = xlTopToBottom
        '.SortMethod = xlPinYin
        '.Apply
    'End With

Sheets(Reponse).Select
Range("A1").Select


End Sub
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
21 juin 2011 à 07:55
Cette ligne ouvre une boite de dialogue pour une recherche dans un autre classeur 
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C,Reponse!C1:C2,2,FALSE)"

Si c'est ce que tu recherches il faut revoir ta formule en faisant une recherche sur le net
VLOOKUP
Sinon si c'est une recherche dans le classeur ouvert il faut employer 
ActiveCell.FormulaR1C1 = "=RechercheV(R2C,Reponse,C1:C2,2,FALSE)"

et revoir ta formule
RechercheV
0
Réponse 6 / 7
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
21 juin 2011 à 08:02
Regarde ceci , c'est bien expliqué pour les 2 cas

http://www.excel-downloads.com/forum/89268-recherchev-en-vba.html
0
Réponse 7 / 7
cs_Vincent58 Messages postés 4 Date d'inscription vendredi 17 juin 2011 Statut Membre Dernière intervention 22 juin 2011
22 juin 2011 à 18:40
Merci pour tout Le Pivert!

J'ai pu finir ma base en temps et en heure grâce à toi! C'était une recherche dans un classeur ouvert que je recherchais, j'ai fini par utiliser: 

Range("B60").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C," & Reponse & "!C1:C2,2,FALSE)"
0

Discussions similaires

Automatiser un publipostage dans Word à partir d'une BD d'Excel
Domilink1963 -
ucfoutu -

2 réponses
[Catégorie modifiée VB6 --> VBA] lancer un publipostage de excel vers word a par
nileduc -
Marion8316 -

2 réponses
Importation données excel vers access
rahmoun111 -
rach_zar -

2 réponses
Import excel vers access
barry54 -
Barry54 -

2 réponses
importer automatique un fichier excel vers access
you85 -
you85 -

2 réponses
Rejoignez-nous