Fermeture classeur

Le 16/09/2013 à 09:53

bonjour,

en fin de macro la ligne Workbooks(WbkB).Close savechanges:=False

me met une erreur ( quand l'onglet a un nom trop long et que celui ci est raccourci par la macro )

cdt

Dim chemin As String, Fichier As String

Dim WbkA As String ' Nom de ce fichier

Dim WbkB As String ' Nom du fichier ouvert

Application.ScreenUpdating = False

WbkA = ThisWorkbook.Name

chemin = Sheets("a").Range("A1").Value"

Fichier = Dir(chemin & "*.xls") ' 1er fichier 'Fichier = Dir(chemin & "*.xl*")

Do While (Len(Fichier) > 0)

If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then

If Fichier <> ThisWorkbook.Name Then

Workbooks.Open chemin & Fichier

WbkB = ActiveWorkbook.Name

Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

' On Error Resume Next

If Len(WbkB) > 31 Then WbkB = Left(WbkB, 10) '& "_" & Right(nomF, 17) & "_" & Int(Rnd() * 100 + 1)

ActiveSheet.Name = WbkB

If Err.Number = 0 Then

ActiveSheet.Name = WbkB

Else

ActiveSheet.Name = WbkB

End If

Workbooks(WbkB).Close savechanges:=False 'ActiveWorkbook.Close

End If

End If

Fichier = Dir() ' fichier suivant

Loop

Le 16/09/2013 à 10:08

Bonjour,

On reprend :

If Len(WbkB) > 31 Then
     nomF = Left(WbkB, 10)
     ActiveSheet.Name=nomF
     ' etc...

nb : n'oublies pas de déclarer nomF en string

Cdlt

Le 16/09/2013 à 10:22

Bonjour,

tu dois laisser WbkB intact et utiliser une autre variable pour renommer l'onglet (comme l'écrit jean-eric et tel que je te l'avais mis dans l'autre fil).

Accessoirement :

If Err.Number = 0 Then
ActiveSheet.Name = WbkB
Else
ActiveSheet.Name = WbkB
End If

ne sert à rien puisque tu fais la même chose dans tous les cas.

eric

Le 16/09/2013 à 17:52

désolé , j'ai beau essayer de comprendre le code , je n'y arrive pas du tout.

je crois que cela marche !! je pense avoir compris la mécanique (grosse satisfaction perso ...)

si quelqu'un peux me dire si je suis dans la vrai et si mon code est "propre "

un petit doute sur <= If Len(WbkB) <= 31 Then

If Fichier <> ThisWorkbook.Name Then

Workbooks.Open chemin & Fichier

WbkB = ActiveWorkbook.Name

WbkC = ActiveWorkbook.Name

Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

' On Error Resume Next

If Len(WbkB) > 31 Then WbkC = Left(WbkB, 10) '& "_" & Right(nomF, 17) & "_" & Int(Rnd() * 100 + 1)

ActiveSheet.Name = WbkC

If Len(WbkB) <= 31 Then ActiveSheet.Name = WbkB '

Workbooks(WbkB).Close savechanges:=False 'ActiveWorkbook.Close

End If

End If

Fichier = Dir() ' fichier suivant

Loop

End Sub

Le 16/09/2013 à 23:59

Ben non, ce n'est pas bon.

Si ton nom de fichier fait moins de 31 caractères tu ne nommes pas ta feuille.

Et puis WbkC comme nom de variable n'est pas heureux : on s'attend à ce que ça désigne un classeur (workbook) et c'est destiné à un nom de feuille...

Pourquoi tu t'obstines à vouloir modifier le code qu'on te donne et qui est sensé fonctionner ?

Reprend ce que je t'avais mis dans l'autre fil, colle-le tel que (remplace ta partie) et teste

eric

Le 17/09/2013 à 13:14

bonjour,

ce n'est pas de la mauvaise volonté , je fais avec mes maigres connaissances vba...

je n'arrivais pas a faire fonctionner le code donc j'ai essayé (on ne va pas me le reprocher..). voir tout en bas

j'ai essayer de le replacer a ta façon cette fois boucle sans do

If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then

If Fichier <> ThisWorkbook.Name Then

Workbooks.Open chemin & Fichier

WbkB = ActiveWorkbook.Name

Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

nomF = ActiveWorkbook.Name

If Len(nomF) > 31 Then nomF = Left(nomF, 10) & "_" & Right(nomF, 17) & "_" & Int(Rnd() * 100 + 1)

ActiveSheet.Name = nomF

End If

Fichier = Dir() ' fichier suivant

Loop

End Sub

par contre dans ce que j'avais mis

si inférieur ou égale à 28 caractères , la feuil prend le nom du classeur source

si plus de 28 caractères, la feuil prend les 17 1ere lettre de ce nom

cela m'a paru bien sur le moment...

WbkB = ActiveWorkbook.Name

WbkC = ActiveWorkbook.Name

Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)

If Len(WbkB) > 28 Then WbkC = Left(WbkB, 17)

ActiveSheet.Name = WbkC

If Len(WbkB) <= 28 Then ActiveSheet.Name = WbkB

Workbooks(WbkB).Close savechanges:=False 'ActiveWorkbook.Close

End If

End If

Fichier = Dir() ' fichier suivant

Loop

Le 17/09/2013 à 15:22

Bonjour,

1) sur le forum merci d'utiliser la balise 'Code' pour que tes lignes de codes soient plus lisibles.

2) extraire un bout du code ne permet pas de savoir s'il est correct. Tu coupes n'importe où et on ne peut pas contrôler si la structure est correcte.

3) toujours déposer un fichier exemple avec le problème, les explications et les manip à faire.

eric

Le 17/09/2013 à 19:02

j'utiliserais la balise code si tu veux la prochaine fois. vraiment désolé

sauf ton respect j'ai l'impression qu'il y a une légère mauvaise fois dans ta réponse...

je vais mettre le sujet en résolu tout de même, la macro fonctionne malgrés tout

encore merci pour tout, c'est grâce à vos conseils sur le 1er poste

Dim chemin As String, Fichier As String
Dim WbkA As String 
Dim WbkB As String 
Dim WbkC As String

  Application.ScreenUpdating = False

  WbkA = ThisWorkbook.Name

  chemin = Sheets("a").Range("B12").Value 
  Fichier = Dir(chemin & "*.xls") 
  Do While (Len(Fichier) > 0)
    If Mid(Fichier, InStrRev(Fichier, ".")) = ".xls" Then
      If Fichier <> ThisWorkbook.Name Then
        Workbooks.Open chemin & Fichier
        WbkB = ActiveWorkbook.Name
        WbkC = ActiveWorkbook.Name
        Workbooks(WbkB).Sheets(1).Copy before:=Workbooks(WbkA).Sheets(1)
   If Len(WbkB) > 28 Then WbkC = Left(WbkB, 17)ActiveSheet.Name = WbkC

If Len(WbkB) <= 28 Then ActiveSheet.Name = WbkB 

 Workbooks(WbkB).Close savechanges:=False 'ActiveWorkbook.Close
 End If
 End If
 Fichier = Dir() ' fichier suivant
 Loop
Le 17/09/2013 à 23:43

sauf ton respect j'ai l'impression qu'il y a une légère mauvaise fois dans ta réponse...

Si tu peux m'expliquer où ? Que j'y veilles la prochaine fois stp.

Tu files des bouts de codes incomplets, jamais de fichiers. Pourquoi devrait-on s'embêter à faire des copié-collés de tes bouts de codes sur un fichier (qui ne ressemblera peut-être pas au tien) alors qu'il est sur ton micro ?

La 3ème fois il était temps de te dire comment faire sur un forum si tu veux motiver les réponses.

J'appelle ça parler clairement.

Si ça ne te plait pas et que ça ne te déranges pas de limiter le nombre de volontaires et d'attendre 10-15 posts pour avoir la fin, pas de soucis, continues comme ça.

eric

Le 18/09/2013 à 00:43

eh bien ne le prend pas mal

c'est juste que depuis le début du post je mettais tout sous la même forme (pas de balise code , a partir du 2eme post c'est vrai que je ne mettais que la partie du code qui posait problème...)

c'est pour cela que je parlais d'une légère mauvaise fois.

le plus souvent c'est vrai que je n'envoi pas de fichier, c'est parce que j'ai a tort l'impression que d'un coup d'œil les "expert" vba

vont voir dans le code où se situe le problème.

j'essairai d'être plus claire la prochaine fois

je ne vais pas épiloguer d'avantage ce n'est pas dans mes habitudes.

Je ne voulais certainement pas t'offusquer

amicalement

Le 18/09/2013 à 01:27

Re,

tu peux remplacer :

If Len(WbkB) > 28 Then WbkC = Left(WbkB, 17)ActiveSheet.Name = WbkC
If Len(WbkB) <= 28 Then ActiveSheet.Name = WbkB

par:

 If Len(WbkC) > 28 Then WbkC = Left(WbkC, 17)
ActiveSheet.Name = WbkC

(le code fourni au départ quoi)

eric

Le 18/09/2013 à 08:01

effectivement cela fonctionne ainsi

merci de ton aide

Rechercher des sujets similaires à "fermeture classeur"