Probleme avec un classeur, et demande d'aide.

WDAndCo

XLDnaute Impliqué
Bonjour le Forum
1) - J'ai un probleme avec un classeur, 2012-12-22_171031.jpg voir la copie d'écran, ce classeur fonctionne sans probleme sur d'autres machines. Pourquoi ?

2) - J'ai le code qui suit (celui qui me pose probleme) ce code liste les classeurs dans un dossier, puis découpe leurs noms pour remplir une BDD.
Code:
Sub ListeTablo()
  Dim DLig As Long, FolderFiles() As Variant
  Dim Tmp As String, fCount As Long
  Dim Ind
  Dim sPath As String
  ' Désinhiber certaines fonctions d'Excel
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  With Sheets("Choix")
    .Activate
    DLig = .Range("R" & Rows.Count).End(xlUp).Row
    If DLig >= 2 Then
      .Range("A2:T" & DLig).ClearContents
    End If
    .Rows("1:1").AutoFilter Field:=17, Criteria1:="="
  End With
  On Error Resume Next
  ActiveSheet.ShowAllData
  On Error GoTo 0
  
  MiseEnPlaceColonnes
  
  ' Initialisation
  sPath = ThisWorkbook.Path & "\Fiche MP\"
  fCount = 0
  Tmp = Dir(sPath & "*.*")
  While Tmp <> Empty
    fCount = fCount + 1
    ReDim Preserve FolderFiles(1 To fCount)
    FolderFiles(fCount) = Tmp
    Tmp = Dir
  Wend
  
  ' Transposer le tableau dans la colonne R
  Dim L&, C&, TSpl
  
  ReDim Trésu(1 To fCount, 1 To 19)
  For L = 1 To fCount
   TSpl = Split(Replace(FolderFiles(L), ".xls", "________"), "_")
    For C = 1 To 19: Trésu(L, C) = TSpl(C): Next C
    Trésu(L, 18) = FolderFiles(L)
    Trésu(L, 19) = "Fiche " & L
    Next L
  Cells(2, 1).Resize(fCount, 19).Value = Trésu
  
  Cells(1, 28).Value = L - 1 'Le Nombre de Fichier en AB1
  
  Remiseazero
  
  ' Inhiber certaines fonctions d'Excel
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  
  Cells.Sort Key1:=Range("R1"), Order1:=xlDescending, Header:=xlYes, _
                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                 DataOption1:=xlSortNormal

  Range("T1").Select
  MsgBox "La Base est à jour !" & Chr$(13) & Chr$(13) & "Avec " & Cells(1, 28).Value & " fiches de Maintenance"
End Sub
Est il possible de ne pas lancer cette macro lorsque le nombre de dossier contenu est égal au nombre en mémoire du tableau qui est dans la cellule AB1 ou Cells(1, 28) car cette Macro prends un certain temps.

D'avance merci.
Dominique
 

Pierrot93

XLDnaute Barbatruc
Re : Probleme avec un classeur, et demande d'aide.

Bonjour,

pour ta 1ère question, peut être une référence manquante, dans l'éditeur vba => barre de menu => outils => références, regarde si il y en a une de "topée" "MANQUANTE", si c'est le cas décoches la, enregistre le classeur ferme le et ré ouvre...

bonne soirée
@+
 

WDAndCo

XLDnaute Impliqué
Re : Probleme avec un classeur, et demande d'aide.

Re en faite il y a cela a l'ouverture du classeur,
Code:
Option Explicit
Private Sub Workbook_Open()
Application.ScreenUpdating = 0
Call ListeTablo
End Sub
voir ma 2eme question pour éviter le lancement de cette macro.
 

Discussions similaires

Réponses
28
Affichages
1 K

Statistiques des forums

Discussions
312 842
Messages
2 092 732
Membres
105 519
dernier inscrit
faivre-roussel.ivan@orang