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" :
Les autres fonctions de la macro:
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 SubLes 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
