Pb dans mon code ouverture de fichier

Le 12/11/2019 à 15:35

Bonjour à tous ,

voici mon code

Dim ListFic(10) As String

Function OuvreCopie(CheminFic As String)

Dim wb As Workbook, Mwb As Workbook

Dim ws As Worksheet, Mws As Worksheet

Dim Societe As String, Attn As String, Comercial As String, NoSem As Integer

Dim LigDeb As Integer, LigFin As Integer

'ATTRIBUTION

Set Mws = ActiveWorkbook.Worksheets("Recap") '........feuille "Recap" du classeur d'origine

Set ws = ActiveWorkbook.Worksheets("Pedido")

Set wb = ActiveWorkbook

'EXECUTION

ws.Rows("14:14").Select '.............................selectionne ligne2

Range(Selection, Selection.End(xlDown)).Select '......selectionne jusqu'en bas, sans la ligne total dario

Selection.SpecialCells(xlCellTypeVisible).Select '....ne selectionne que les lignes non masquées

Selection.Copy '......................................copie

Mws.Activate '........................................active la feuille 1 dans le classeur d'origine

Range("a11").Select '.................................selectionne a11

Selection.End(xlDown).Offset(1, 0).Select '...........saute jusqu'en bas de la liste, puis décale encore de 1 ligne vers le bas

ActiveSheet.Paste '...................................colle

Application.CutCopyMode = False '.....................sort du mode copie (pointillé clignotant)

LigDeb = Selection.Row '..............................définit le no de lign edu début et de la fin de la copie

LigFin = LigDeb + Selection.Rows.Count - 1

ws.Activate '.........................................récuppère les infos

Societe = Range("h1").Value

Attn = Range("h2").Value

Comercial = Range("d9").Value

NoSem = Range("e7").Value

Mws.Activate '........................................copie les infos sur toute la hauteur de la selection

Range("n" & LigDeb, "n" & LigFin).Value = Societe

Range("o" & LigDeb, "o" & LigFin).Value = Attn

Range("p" & LigDeb, "p" & LigFin).Value = NoSem

Range("q" & LigDeb, "q" & LigFin).Value = Comercial

'FERMETURE

wb.Close

Set ws = Nothing

Set Mws = Nothing

End Function

Seulement quand je le lance il m'indique une erreur : erreur d'exécution '424' Objet requis !!!

alors que quand je détaille ligne par ligne cela fonctionne correctement !

Merci par avance pour votre aide,

Le 12/11/2019 à 15:42

Bonjour barth66,

Sur quelle ligne est l'erreur quand tu fais le débogage ?

Rajoute un

Option Explicit

tout en haut de ton code. Cela te permet de voir si tu as bien déclaré toutes tes variables.

Bien cordialement,

AP

Le 12/11/2019 à 16:01

Bonjour et merci pour ce retour ,

ci joint la copie écran du message d'erreur je ne comprends pas j'ai bien déclarer les variables non ?

capture
Le 12/11/2019 à 16:06

Petite précision: Ton message d'erreur n'est pas le même que dans ton premier message, as tu mis

Option Explicit

? Si non, pourquoi ce n'est pas le même message d'erreur ?

De plus j'ai l'impression de ne pas avoir l'intégralité de ton code. Si c'est le cas, compliqué de t'ouvrer l'erreur…

Bien à toi,

Amitiés

Le 12/11/2019 à 16:08

Je pense peut-être avoir trouvé. Tu met

Range("B1").Value

mais de quelle feuille ?

Il faut que tu précise

Worksheets("Feuil").Range("B1").Value

Bien cordialement,

AP

Le 12/11/2019 à 16:22

Merci mais toujours le même message...

Le 12/11/2019 à 16:31

Voici le code entier :

Option Explicit

Dim ListFic(10) As String

Function OuvreCopie(CheminFic As String)

Dim wb As Workbook, Mwb As Workbook

Dim ws As Worksheet, Mws As Worksheet

Dim Societe As String, Attn As String, Comercial As String, NoSem As Integer

Dim LigDeb As Integer, LigFin As Integer

'ATTRIBUTION

Set Mws = ActiveWorkbook.Worksheets("Recap") '........feuille "Recap" du classeur d'origine

Set ws = ActiveWorkbook.Worksheets("Pedido")

Set wb = ActiveWorkbook

'EXECUTION

ws.Rows("14:14").Select '.............................selectionne ligne2

Range(Selection, Selection.End(xlDown)).Select '......selectionne jusqu'en bas, sans la ligne total dario

Selection.SpecialCells(xlCellTypeVisible).Select '....ne selectionne que les lignes non masquées

Selection.Copy '......................................copie

Mws.Activate '........................................active la feuille 1 dans le classeur d'origine

Range("a11").Select '.................................selectionne a11

Selection.End(xlDown).Offset(1, 0).Select '...........saute jusqu'en bas de la liste, puis décale encore de 1 ligne vers le bas

ActiveSheet.Paste '...................................colle

Application.CutCopyMode = False '.....................sort du mode copie (pointillé clignotant)

LigDeb = Selection.Row '..............................définit le no de lign edu début et de la fin de la copie

LigFin = LigDeb + Selection.Rows.Count - 1

ws.Activate '.........................................récuppère les infos

Societe = Range("h1").Value

Attn = Range("h2").Value

Comercial = Range("d9").Value

NoSem = Range("e7").Value

Mws.Activate '........................................copie les infos sur toute la hauteur de la selection

Range("n" & LigDeb, "n" & LigFin).Value = Societe

Range("o" & LigDeb, "o" & LigFin).Value = Attn

Range("p" & LigDeb, "p" & LigFin).Value = NoSem

Range("q" & LigDeb, "q" & LigFin).Value = Comercial

'FERMETURE

wb.Close

Set ws = Nothing

Set Mws = Nothing

End Function

Sub BoucleFichiers()

Dim Chemin As String, Fichier As String

Dim i As Integer, j As Integer

Erase ListFic

'Application.ScreenUpdating = False ' supprime l'affichage de toutes les étapes

'Définit le répertoire contenant les fichiers

Chemin = Range("c1").Value & "\semaine" & Range("e5").Value & "\"

i = 1

j = 1

'Boucle sur tous les fichiers xlsm du répertoire...

Fichier = Dir(Chemin & "*.xlsm")

'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:

'Fichier = Dir(Chemin & "*.*")

'... et écrit le résultat dans le tableau ListFic.

Do While Len(Fichier) > 0

ListFic(i) = Chemin & Fichier

i = i + 1

Fichier = Dir()

Loop

'Ouvre successivement les fichiers et récuppère les données (grâce à la fonction)

Do While ListFic(j) <> ""

OuvreCopie (ListFic(j))

j = j + 1

Loop

'Masque tous les jours sauf celui en A1

DisplayJourSem = Worksheets("Feuil").Range("A1").Value

Select Case DisplayJourSem

Case "Lunes"

Range("h1:l1").Select

Case "Martes"

Application.Union(Range("g1:g1"), Range("i1:l1")).Select

Case "Miercoles"

Application.Union(Range("g1:h1"), Range("j1:l1")).Select

Case "Jueves"

Range("g1:i1", "k1:l1").Select

Application.Union(Range("g1:i1"), Range("k1:l1")).Select

Case "Viernes"

Range("g1:j1", "l1").Select

Application.Union(Range("g1:j1"), Range("l1:l1")).Select

Case "Sabado"

Range("g1:k1").Select

Case "Domingo"

MsgBox ("Pas de dimanche dans le tableau")

Case Else

MsgBox ("Mauvaise saisie dans la cellule a1")

End Select

Selection.EntireColumn.Hidden = True

'Application.ScreenUpdating = True ' ré-allume l'affichage de toutes les étapes

MsgBox "fin des opérations"

End Sub

Le 12/11/2019 à 16:34

qu'est ce que

 DisplayJourSem

?

Bien cordialement,

AP

Le 12/11/2019 à 16:43

car j'ai une liste déroulante avec une selection des jours de semaine qui varient ,

Le display n'est pas le bn terme ?

Cdt,

Le 13/11/2019 à 08:09

Bonjour barth, le forum,

Donc

DisplayJourSem

est le nom d'une combobox. Essaye en mettant un

Me.DisplayJourSem.Value

à la place.

Bien cordialement,

AP

Le 13/11/2019 à 09:16

Bonjour MPETIT,

merci pour votre retour mais en remplencant voici le message que j'obtient

capture
Rechercher des sujets similaires à "mon code ouverture fichier"