macro fonctionne sous excel 2003 mais pas 2007

faroukal

XLDnaute Nouveau
Bonjour,

Avec l'aide de généreux membres de ce forum, j'avais pu mettre en place il y a quelques mois une petite application sous Excel pour faire des recherches sur des communes (pour avoir les jours de passage).

La macro fonctionne à merveille mais en passant à Excel 2007, on constate qu'il y a un souci car à chaque recherche le résultat obtenu est: "il n'y a aucun résultat correspondant à votre recherche"! J'ai essayé de comprendre ce qui n'allait pas dans le code, sans succès.

C'est pourquoi je me permets de poser mon problème ici pour savoir si quelqu'un peut m'aider à résoudre ce problème.

Le module "recherche" :
Code:
Option Explicit
Private Declare Function EnableWindow Lib "user32" _
(ByVal hWnd As Long, ByVal fEnable As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Effacer_Click()
    CP.Value = ""
    Commune.Value = ""
End Sub

Private Sub fermer_Click()
    cherche.Hide
    Unload cherche
End Sub

Private Sub Label4_Click()

End Sub

Private Sub Lancer_Click()
    Resultat.BackColor = &H80000005
    If CP = "" And Commune = "" Then Exit Sub
    Effacer.Enabled = False
    CP.Enabled = True
    Commune.Enabled = True
    Lancer.Enabled = False
    Nouvelle.Enabled = True
        Resultat.SetFocus
    
    
          
    '-----------Saisie de la zone de critères----------
    
    With Worksheets("data")
        .[L1] = "CP"
        .[L2] = CP.Value
        .[M1] = "nom"
        .[M2] = "*" & Commune.Value & "*"
        .Range("A1:G900").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=.Range("L1:M2")
    
    
    '-----------Remplissage de la liste----------
    Dim cel As Range, result
    

        
    Dim CPT
    CPT = 0
    On Error Resume Next
    For Each cel In .[C2:C900].SpecialCells(xlCellTypeVisible)
    If Err.Number <> 0 Then
        Resultat.AddItem "Pas de communes correspondantes"
        Beep
        Exit Sub
    Else
        If cel.Value <> "" Then
            Resultat.AddItem
            Resultat.Column(0, CPT) = Format(Worksheets("data").Range("B" & cel.Row).Value, "00000") & " - " & cel.Value
            Resultat.Column(1, CPT) = cel.Offset(0, 1)
            Resultat.Column(2, CPT) = cel.Offset(0, 2)
            Resultat.Column(3, CPT) = Format(cel.Offset(0, 3), "0.00")
            Resultat.Column(4, CPT) = Format(cel.Offset(0, 4), "0.00")
            
            CPT = CPT + 1
        End If
    End If
    Next
    End With
    NB.Caption = CPT & " Commune(s) trouvée(s)"
    Beep
End Sub

Private Sub Nouvelle_Click()
    NB.Caption = "Indiquez vos critères de recherche"
    Resultat.BackColor = &H8000000F
    Effacer.Enabled = True
    CP.Enabled = True
    Commune.Enabled = True
    Lancer.Enabled = True
    Nouvelle.Enabled = False
    Worksheets("data").ShowAllData
 
    While Resultat.ListCount >= 1
        If Resultat.ListIndex = -1 Then
            Resultat.ListIndex = Resultat.ListCount - 1
        End If
        Resultat.RemoveItem (Resultat.ListIndex)
    Wend
End Sub
Private Sub Resultat_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = True
    

    
End Sub


Private Sub UserForm_Activate()
     EnableWindow FindWindow(vbNullString, Application.Caption), 1
    Resultat.BackColor = &H8000000F
    NB.Caption = "Indiquez vos critères de recherche"
End Sub

Les autres fonctions de la macro:
Code:
Option Explicit
Sub import()
    Dim chemin As String
    chemin = ActiveWorkbook.Path
    Workbooks.OpenText FileName:=chemin & "\Communes.txt", _
    DataType:=xlDelimited, Tab:=True
    Selection.CurrentRegion.Copy
    Workbooks("communes.xls").Activate
    Range("A1").Select
    Sheets.Add
    With ActiveSheet
        .Select
        .Name = "Data"
        .Paste
        .Visible = False
    End With

    Application.CutCopyMode = False
    
    Workbooks("Communes.txt").Activate
    ActiveWorkbook.Close

    Workbooks("Communes.xls").Activate
    Worksheets("accueil").Activate
    Range("A800").Select
    ActiveWindow.ScrollRow = 1

End Sub
Sub Chercher()
   #If VBA6 Then
  cherche.Show 0
    #Else
  cherche.Show
    #End If

End Sub
Sub sortir()
    ActiveWorkbook.Save
    With ActiveWindow
    .DisplayHorizontalScrollBar = True
    .DisplayVerticalScrollBar = True
    .DisplayWorkbookTabs = True
    End With
    AfficherBO
    ActiveWorkbook.Close SaveChanges:=False
End Sub
Sub Reimporter()
    Dim rep
    rep = MsgBox("La fonction d'importation vous permet, si vous avez modifié le fichier Communes.txt (ajout / modification / suppression d'une commune)." & vbCr & vbCr _
        & "Si vous n'avez pas apporté de modification au fichier, la ré-importation permet de réinitialiser la liste des communes." & vbCr & vbCr _
        & "Voulez-vous procéder à la ré-importation des communes ?", vbYesNo, "Ré-importation des communes")
    If rep = vbYes Then
        Application.DisplayAlerts = False
        If Sheets(1).Name = "Data" Then Sheets("Data").Delete
        Application.DisplayAlerts = True
        MasquerBO
        import
    End If
End Sub

Code:
Option Explicit

Sub AfficherBO()
    Application.DisplayFormulaBar = True
    Application.CommandBars.ActiveMenuBar.Enabled = True
    Application.CommandBars("Formatting").Visible = True
    Application.CommandBars("Standard").Visible = True
    Application.CommandBars("drawing").Visible = True
    Application.DisplayStatusBar = True
    
    Application.WindowState = xlMaximized

End Sub
Sub MasquerBO()
    Application.DisplayFormulaBar = False
    Application.CommandBars.ActiveMenuBar.Enabled = False
    Application.CommandBars("Formatting").Visible = False
    Application.CommandBars("Standard").Visible = False
    Application.CommandBars("drawing").Visible = False
    Application.DisplayStatusBar = False
    
    
    Application.WindowState = xlMaximized
    
End Sub
 

faroukal

XLDnaute Nouveau
Re : macro fonctionne sous excel 2003 mais pas 2007

Bonjour et merci de votre réponse.

Vous trouverez en PJ mon fichier.

Attention à l'ouverture l'apparence de la fenêtre d'Excel est modifiée.

Après fermeture tout redevient normal.

Cordialement.

ATTENTION: Pour pouvoir déziper le fichier joint, il faut utiliser 7-ZIP (sinon le décompresseur de windows ne pourra pas ouvrir le fichier car compression ULTRA par 7-ZIP).
 

Pièces jointes

  • communes.zip
    45.5 KB · Affichages: 58
  • communes.zip
    45.5 KB · Affichages: 62
  • communes.zip
    45.5 KB · Affichages: 61
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : macro fonctionne sous excel 2003 mais pas 2007

Re

A 1ere vue la methode showalldata pose probleme

j'ai pu faire fonctionner avec:

Code:
Private Sub Lancer_Click()
    Resultat.BackColor = &H80000005
    If CP = "" And Commune = "" Then Exit Sub
    Effacer.Enabled = False
    CP.Enabled = True
    Commune.Enabled = True
    Lancer.Enabled = False
    Nouvelle.Enabled = True
        Resultat.SetFocus
    '-----------Saisie de la zone de critères----------
    With Worksheets("data")
        .Range("A1").AutoFilter
        .[L1] = "CP"
        .[L2] = CP.Value
        .[M1] = "nom"
        .[M2] = "*" & Commune.Value & "*"
        .Range("A1:G900").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=.Range("L1:M2")
    '-----------Remplissage de la liste----------
    Dim cel As Range, result
    Dim CPT
    CPT = 0
    On Error Resume Next
    For Each cel In .[C2:C900].SpecialCells(xlCellTypeVisible)
    If Err.Number <> 0 Then
        Resultat.AddItem "Pas de communes correspondantes"
        Beep
        Exit Sub
    Else
        If cel.Value <> "" Then
            Resultat.AddItem
            Resultat.Column(0, CPT) = Format(Worksheets("data").Range("B" & cel.Row).Value, "00000") & " - " & cel.Value
            Resultat.Column(1, CPT) = cel.Offset(0, 1)
            Resultat.Column(2, CPT) = cel.Offset(0, 2)
            Resultat.Column(3, CPT) = Format(cel.Offset(0, 3), "0.00")
            Resultat.Column(4, CPT) = Format(cel.Offset(0, 4), "0.00")
            CPT = CPT + 1
        End If
    End If
    Next
    End With
    NB.Caption = CPT & " Commune(s) trouvée(s)"
    Beep
End Sub
Private Sub Nouvelle_Click()
    NB.Caption = "Indiquez vos critères de recherche"
    Resultat.BackColor = &H8000000F
    Effacer.Enabled = True
    CP.Enabled = True
    Commune.Enabled = True
    Lancer.Enabled = True
    Nouvelle.Enabled = False
    While Resultat.ListCount >= 1
        If Resultat.ListIndex = -1 Then
            Resultat.ListIndex = Resultat.ListCount - 1
        End If
        Resultat.RemoveItem (Resultat.ListIndex)
    Wend
End Sub
 

faroukal

XLDnaute Nouveau
Re : macro fonctionne sous excel 2003 mais pas 2007

Bonjour

J'ai remplacé mon code avec le votre mais la macro me donne toujours "aucun résultat" alors que normalement il faudrait y avoir des résultats...

J'ai l'impression que le problème se trouve ici, car quand je modifie L1:M1 vers A:K, j'ai toute la liste des villes qui s'affichent comme résultat de recherche....

Code:
 With Worksheets("data")
        .Range("A1").AutoFilter
        .[L1] = "CP"
        .[L2] = CP.Value
        .[M1] = "nom"
        .[M2] = "*" & Commune.Value & "*"
        .Range("A1:G900").AdvancedFilter _
        Action:=xlFilterInPlace, _
        CriteriaRange:=.Range("L1:M2")
 

faroukal

XLDnaute Nouveau
Re : macro fonctionne sous excel 2003 mais pas 2007

Bonjour!
En fait ça fonctionne chez moi aussi, le problème est au niveau du résultat de la recherche.

Lorsque vous tapez "Metz", chez vous, est-ce que vous avez le résultat pour "Metz", ou bien: "Aucun résultat ne correspond à votre recherche"?.

Sur Excel 2003, les résultats s'affichent; par contre sur 2007, "Aucun résultat ne correspond à la recherche"...

Cordialement
 

faroukal

XLDnaute Nouveau
Re : macro fonctionne sous excel 2003 mais pas 2007

Je suis vraiment étonné car chez moi, sous Excel 2003, c'est OK, et puis sur 2007, voilà le résultat : (voir PJ) !!

Où est le problème??? Je deviens fou!
 

Pièces jointes

  • ecran.png
    ecran.png
    30.6 KB · Affichages: 110

pierrejean

XLDnaute Barbatruc
Re : macro fonctionne sous excel 2003 mais pas 2007

Re

Il n'est pas impossible qu'une erreur soit a la base de ce Resultat
Tester cette version ou un on error resume next a été mis en commentaire

Code:
[COLOR=blue]'On Error Resume Next[/COLOR]
    For Each cel In .[C2:C900].SpecialCells(xlCellTypeVisible)
   [COLOR=blue]'If Err.Number <> 0 Then[/COLOR]
[COLOR=blue]       'Resultat.AddItem "Pas de communes correspondantes"[/COLOR]
[COLOR=blue]       'Beep[/COLOR]
[COLOR=blue]       'Exit Sub[/COLOR]
[COLOR=blue]   'Else[/COLOR]
        If cel.Value <> "" Then
            Resultat.AddItem
            Resultat.Column(0, CPT) = Format(Worksheets("data").Range("B" & cel.Row).Value, "00000") & " - " & cel.Value
            Resultat.Column(1, CPT) = cel.Offset(0, 1)
            Resultat.Column(2, CPT) = cel.Offset(0, 2)
            Resultat.Column(3, CPT) = Format(cel.Offset(0, 3), "0.00")
            Resultat.Column(4, CPT) = Format(cel.Offset(0, 4), "0.00")
            CPT = CPT + 1
        End If
   [COLOR=blue]'End If[/COLOR]
    Next
 

Pièces jointes

  • Communes.zip
    61.1 KB · Affichages: 59
  • Communes.zip
    61.1 KB · Affichages: 55
  • Communes.zip
    61.1 KB · Affichages: 58

faroukal

XLDnaute Nouveau
Re : macro fonctionne sous excel 2003 mais pas 2007

Bonjour
Je vous remercie de votre aide! Chez moi, ça fonctionne. J'ai testé les différentes versions de la macro de la première que j'ai soumise jusqu'à la dernière que vous avez envoyée et elles fonctionnent toutes correctement.
Je ne comprends pas pourquoi ça ne marchait pas sur mon PC de bureau!
Qu'avez-vous changé dans votre dernière version SVP? Quelle est la différence entre la mise en commentaire du code que vous avez souligné et sa version originale?
Cordialement
 
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : macro fonctionne sous excel 2003 mais pas 2007

Re

Dans la derniere version j'ai mis en commentaire un
on error resume next
et les lignes associées afin de provoquer un debug sur une erreur non prevue aboutissant a
'Resultat.AddItem "Pas de communes correspondantes"
A tester donc sur le PC de bureau

 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo