donner un format .xls a : for each ceel

[JC de Lorient]

Bonsoir le forum

je sèche depuis le début d'après midi sur ça
j'ai en VBA : For Each cell In Range('listevendeur')

lister ces cellules ne pose aucun problème

par contre serait il possible d'obtenir quelquechose dans le genre :monfichier=cell.name &'.xls'
j'ai essayé +sieurs choses mé sans résultats

merci a vous

JC

 

[JC de Lorient]

re le forum

ben voilà a force de persévérence on y arrive !!!

j'ai résolu ce 1er point

maintenat j'aimerais vérifier l'existence du classeur avant de l'ouvrir

en clair regarder dans le répertoire 'mon répertoire' si 'mon classeur' existe si oui ensuite .....

merci a vous

JC

 

[myDearFriend!]

Bonsoir JC,

Tu peux essayer quelque chose comme ça :

Dim Chemin As String
      Chemin = 'C:\MonDossier\MonClasseur.xls'
      MsgBox IIf(Dir(Chemin) <> '', 'Fichier trouvé', 'Fichier non trouvé')

Cordialement.

 

[JC de Lorient]

re le forum

merci MDF pour ton info ça marche comme il faut


chemin = ThisWorkbook.Path
Ws = cell.Value & '.xls'
n = IIf(Dir(chemin & '\\' & Ws) <> '', 'ok', 'oups')
If n = 'ok' Then...


jusque là tout roule mais maintenat je bloque sur le fait d'activer la feuille Ws

un coup de main serait le bienvenu !

merci Bcp

JC

 

[Mytå]

Salut JC de Lorient, MyDearFriend et le Forum

Essaye avec ceci

Option Explicit

  Public fPath As String
  Public fName As String
  Public sName As String
  Public fullName As String
  Public dirName As String
  
Sub Ouvrir()

fPath = 'D:\\Sauvergarde'
fName = 'Lecture_2004.xls'
sName = 'Data'
fullName = '='' & fPath & '\\[' & fName & ']' & sName & ''!'
dirName = fPath & '\\' & fName

Workbooks.Open dirName

Windows('Lecture_2004.xls').Activate

'Ici le traitement
    
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

Myt&aring;

 

[JC de Lorient]

Bonjour le forum, Myt&aring;, MDF

j'ai 'enfin' réussi a faire fonctionné mon code et ce grace a vous !!

le voiçi :

chemin = ThisWorkbook.Path
p = 26
For Each cell In Range('listevendeur')
If cell <> 0 Then
Ws = (chemin & '\\' & cell.Value & '.xls')
n = IIf(Dir(Ws) <> '', 'ok', 'oups')
If n = 'ok' Then

Workbooks.Open Ws

' Range('a' & p) = Ws
' Range('b' & p) = n

p = p + 1
End If
End If
Next

A la place de : Workbooks.Open Ws

je voudrais seulement aller chercher une valeur en fait cipier la ligne A67:H67 et ça sans ouvrir si possible le classeur ou alors de l'ouvrir et le réfermer sans enregistrer les modifs
mé ça je sais pas comment l'écrire

merci a vous et bon dimanche
JC

 

[JC de Lorient]

re tout le monde !

Encore une question sur mon code
après ceci : For Each cell In Range('listevendeur')
est il possible d'obtenir le N° de la ligne de 'cell' ?
si oui avec quelle instruction

merci encore
JC

 

[JC de Lorient]

re le forum

voilà suis presque au bout

voiçi mon code (presque) terminé

chemin = ThisWorkbook.Path
For Each cell In Range('listevendeur')
ligne = cell.Row
If cell <> 0 Then
Ws = (chemin & '\\' & cell.Value & '.xls')
n = IIf(Dir(Ws) <> '', 'ok', 'oups')
If n = 'ok' Then
Application.ScreenUpdating = False
Workbooks.Open Ws
Range('B67:G67').Copy
ActiveWorkbook.Close
ActiveWorkbook.Saved = True
Workbooks('Calcul.xls').Activate
Sheets('SAISIE').Range('B' & ligne).PasteSpecial
Application.CutCopyMode = False
Application.ScreenUpdating = True

End If
End If
Next

sur ces lignes

Workbooks.Open Ws
Range('B67:G67').Copy
ActiveWorkbook.Close
ActiveWorkbook.Saved = True

Comment récupérer les valeurs B67:G67 sans ouvrir le classeur

et içi :
Workbooks('Calcul.xls').Activate
Sheets('SAISIE').Range('B' & ligne).PasteSpecial

En B67 j'ai une valeur numérique et lorsque je copie les cellules je perds ce format numérique ( j'ai des cumuls a faire après)

merci de votre aide

JC

 

[JC de Lorient]

Bonsoir le forum

j'avance, j'avance mais quelle galère

voiçi mon code presque terminé :

Sub Récup()
sem = InputBox('Données de la semaine : sous forme de 2 chiffres', 'Recherche des données')
If sem <> '2' Then
If Len(sem) = 2 Then
sem = 'sem ' + sem
If Range('A5') <> sem Then

Range('A5').Value = sem
Range('B9:AD24').ClearContents
chemin = ThisWorkbook.Path 'attribue le chemin d'accès
For Each cell In Range('listevendeur')
ligne = cell.Row ' mémorise le N° de ligne
If cell <> 0 Then
Ws = (chemin & '\\' & cell.Value & '.xls') ' attribue le fichier a Ws
n = IIf(Dir(Ws) <> '', 'ok', 'oups') ' vérifie l'existence du classeur
If n = 'ok' Then
Application.ScreenUpdating = False
Workbooks.Open Ws
Range('B67:AB67').Copy
ActiveWorkbook.Close False
Workbooks('Calcul.xls').Activate
Sheets('SAISIE').Range('B' & ligne).PasteSpecial 'Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If
Next

Else: MsgBox ('erreur de format')
Else: MsgBox ('Cette semaine a déjà été chargée')

Range('B9').Select
Exit Sub
End If
End Sub

1er souci sans résultat : mes If
j'en ai 5 ce que je souhaiterais obtenir
sur le 1er : sortir de la macro car click sur annuler dans msgbox
sur le 2ème : erreur de format car différent de 2 caractères
sur le 3ème : message : Cette semaine a déjà été chargée
4ème et 5ème eux au moins ils fontionnent ! lol

et tjrs mon soucis de valeur numérique du précédent post ainsi que récupérer les données sans ouvrir les classeurs (moins grave)

merci a vous tous et toutes
JC

 

[myDearFriend!]

Bonsoir JC, Myt&aring;,

JC, je ne suis pas s&ucirc;r d'avoir tout compris dans ta procédure. Aussi, sans pouvoir tester, je tente quand même une approche de code pour essayer de répondre à tes questions...

Option Explicit

Sub Recup()
Dim cell As Range
Dim Chemin As String
Dim Ligne As Long
Dim sem As Variant   '(valeurs attendues : Nombres ou False, puis Chaine de caractères)
     
      'Utilisation de Application.InputBox(...,...,Type:=2) qui permet de n'obtenir que des chiffres en réponse
      sem = Application.InputBox(prompt:='Données de la semaine : sous forme de 2 chiffres', _
                  Title:='Recherche des données', Type:=1)
      'Sortir si choix 'Annuler'
      If sem = False Then Exit Sub
      'Sortir si valeur non reconnue
      If sem < 1 Or sem > 52 Then
            MsgBox ('erreur de format')
            Exit Sub
      End If
      'Semaine déjà chargée ?
      sem = 'sem ' + Format(sem, '00')
      If Range('A5') = sem Then
            MsgBox ('Cette semaine a déjà été chargée')
            Exit Sub
      End If
      'Traitement
      Application.ScreenUpdating = False
      Range('A5').Value = sem
      Range('B9:AD24').ClearContents
      For Each cell In Range('listevendeur')
            Ligne = cell.Row ' mémorise le N° de ligne
            If cell <> 0 Then
                  Chemin = ThisWorkbook.Path & '\' & cell.Value & '.xls'   'attribue le chemin d'accès
                  If Dir(Chemin) <> '' Then           ' vérifie l'existence du classeur
                        Workbooks.Open Chemin
                        'Sheets('Feuil1') ci-dessous à adapter...
                        ActiveWorkbook.Sheets('Feuil1').Range('B67:AB67').Copy Destination:= _
                              Workbooks('Calcul.xls').Sheets('SAISIE').Range('B' & Ligne & ':AB' & Ligne)
                        Application.CutCopyMode = False
                        ActiveWorkbook.Close False
                  End If
            End If
      Next
      Workbooks('Calcul.xls').Activate
      Sheets('SAISIE').Activate
      Range('B9').Select
      Application.ScreenUpdating = True
End Sub

Par ailleurs, comme je le fais de temps en temps, je me permets de t'inviter à déclarer TOUTES les variables avec lesquelles tu travailles. Pour t'éviter quelques surprises futures, je ne puis que te conseiller de mettre une ligne 'Option Explicit' en tête de chacun de tes modules de code. Cela t'obligera à déclarer l'ensemble des variables que tu utilises. Et pour ne pas avoir à mettre manuellement 'Option Explicit' dans chaque nouveau module que tu insères, tu peux faire Menu Outils / Options.../ Onglets 'Editeur' et cocher 'Déclaration des variables obligatoire' depuis l'éditeur VBE.

Cordialement.

Message édité par: myDearFriend!, à: 17/04/2005 21:30

 

[JC de Lorient]

Bonsoir le forum

ben je suis un peu ébahi par la vitesse a laquelle tu 'ponds' de tel code !!

ça marche plutot bien le seul souci c que dans ce code

ActiveWorkbook.Sheets('mars').Range('B67:AB67').Copy Destination:= _
Workbooks('Copie de Calcul.xls').Sheets('SAISIE').Range('B' & Ligne & ':AB' & Ligne)

il me copie les valeurs et non pas les formules

en tous cas mille merci a toi
très bonne fin de soirée

JC

 

[JC de Lorient]

souci de code

Bonjour le forum

je me permets de relancer mon post
en effet je devais etre fatigué hier !!
sur le dernier post je vous avais demandé ceci:

'il me copie les valeurs et non pas les formules'
en fait c l'inverse !! il me copie les formules alors que ce sont les valeurs que je souhaite récupérer

2ème point
dans ce code : If Range('A5') <= Right(sem, 2)
je voudrais récupérer aussi le Right((A5),2)

suis sans résultat après de multiples essais

Merci a vous

JC