COMPATIBILITE VBA ENTRE LES VERSIONS D'EXCEL

[thombar]

Bonjour,

J'ai crée un classeur rempli de macros récupérées à droite et à gauche sur le net et personnalisées. Tout fonctionne très bien sous Excel 97.

J'ai eu l'occasion de le tester sous Excel 2000 et Excel XP mais une des macros ne semble pas être interprétée dans ces versions (erreur).

Existe t'il un outil qui identifie les parties de script qui ne sont pas compatibles d'une version à une autre, et qui propose éventuellement un correctif ?
_________________________________________________

Je ne peux pas être affirmatif car je n'ai pas les récentes versions d'Excel sous la main, mais le code qui semble ne pas convenir serait celui-ci :

Sub MAMACRO()
choix = ChoixDossierFichier("", 1)
If choix <> "" Then
End If
etc........
End sub


Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$

If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
On Error GoTo fin

Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""

If objFolder.Title = "" Then
Chemin = ""
End If

SecuriteSlash = InStr(objFolder.Title, "")

If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
fin:
End Function

 

[@+Thierry]

Bonjour Thombar, le Forum


A première vue, ce que je peux te dire c'est que ce code fonctionne sous :

Win 2000 Pro S/P 3 /// Office 9.0 (US Version) (Excel 2000)

Win XP Pro 5.1 S/P 1 / Office 10.0 (Excel XP 2002)

J'ai bien un Pop Up avec "Chosissez un Fichier", la différence sous XP c'est un bouton de plus "Make New Folder" qui n'apparait pas sous 2000.

Sinon il te sert à quoi ce code ?

Bon Aprèm
@+Thierry

 

[thombar]

Alors il s'agit peut être d'un autre code qui me fait une erreur... il faut que je refasse des tests dès que possible.


Sinon, ce code très pratique me permet d'aller sélectionner un fichier par l'intermédiaire d'une fenêtre, et d'en récupérer le chemin pour l'ouvrir plus loin dans la macro... voilà voilà.... merci quand même !!

 

[@+Thierry]

Re Thombar, le Forum

Ah je comprends mieux l'usage que tu fais de ce code (Pour la petite histoire ce code est de Ole P Erlandsen, adaptée par Frédérique Sigonneau)

Si ce n'est que pour avoir la boite de dialogue et récupérer le nom/chemin du fichier en variable, tu n'as pas besoin de toute cette artillerie qui est faite pour lister (entre autre) tout le contenu (répertoires et fichiers) depuis une racine donnée.

Une suggestion, pourquoi ne pas utiliser pour un fichier particulier le "GetOpenFilename" bien plus léger et simple d'emploi ?

Un exemple d'utilisation de GetOpenFilename dans ce fil : Lien supprimé(Et aussi un exemple de remerciement sympa de la part de Guillaume en bas de ce fil)

Bon Courage et Bon Week End
@+Thierry

 

[thombar]

Bonjour,

En fait j'utilise ce code car je souhiate que l'utilisateur aille chercher une fiche qu'il aurait pu mettre n'importe où (sur un disque local, même réseau).

Je m'explique : j'ai créé un formulaire qui créé lui-même des fiches (qui sont en tout points similaires à ce formulaire sauf que j'en retire toutes les macros, les images etc...)

Sur ce formulaire, j'ai créé un bouton "consulter" (MAMACRO) qui lance la macro de Ole P Erlandsen, Frédérique Sigonneau), et après sélection d'une fiche par l'utilisateur, la macro va pomper les valeurs à des endroits précis pour les rapatrier dans le formulaire. J'ai retesté sur une version récente d'Excel, et il ne se pase rien quand on sélectionne la fiche : (je pense que cela vient au moment on la macro copie en E1 le nom du fichier....)

Sub MAMACRO()

Rep = MsgBox("Consultation d'une fiche.", vbYesNo)
If Rep = vbYes Then

choix = ChoixDossierFichier("", 1)
If choix <> "" Then
End If

Range("E1") = choix
Dim valeur As String
On Error Resume Next
cellule = Range("E1")
valeur = "": valeur = Application.WorksheetFunction.Find("MOVE", cellule, 1) ' La fiche doit absolument comporter le mot MOVE au début de son nom

If valeur <> "" Then
Range("E1").Replace What:="", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False

Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(choix, True, True)
With ThisWorkbook.Worksheets("MOVE") ' la feuille s'appelle MOVE

.Range("C13:I15").Value = wb.Worksheets("MOVE").Range("C13:I15").Value
.Range("I6:I9").Value = wb.Worksheets("MOVE").Range("I6:I9").Value
.Range("D1928").Value = wb.Worksheets("MOVE").Range("D1928").Value
.Range("D5455").Value = wb.Worksheets("MOVE").Range("D5455").Value
.Range("A57").Value = wb.Worksheets("MOVE").Range("A57").Value
.Range("A58").Value = wb.Worksheets("MOVE").Range("A58").Value
.Range("I19:I28").Value = wb.Worksheets("MOVE").Range("I19:I28").Value
.Range("I30").Value = wb.Worksheets("MOVE").Range("I30").Value
.Range("I54:I55").Value = wb.Worksheets("MOVE").Range("I54:I55").Value
.Range("F57").Value = wb.Worksheets("MOVE").Range("F57").Value

End With
wb.Close False
Set wb = Nothing
Application.ScreenUpdating = True

With Worksheets("MOVE")
.Protect UserInterfaceOnly:=True
.EnableSelection = xlUnlockedCells
End With

End If
End If
End Sub


Voila, les données ne sont pas rapatriées si je suis sur Excel XP. Cela fonctionne parfaitement bien avec Excel 97 ...???!!!!

 

[thombar]

Je relance le post.

Pouvez-vous m'aider ? pleeeaaase .......


merci

 

[@+Thierry]

Salut Thomas, le Forum

J'ai essayé ta macro, sous Win 2000 / Excel 2000 çà "passe" encore pour peu qu'on respecte la casse du mot "MOVE"...

Mais sous Win XP Pro / Excel XP 2002 il ne se passe rien et c'est bien le "Choix" qui n'est pas retourné bien que la DialogBox Open se lance. Mais je ne vais pas reprendre la Function Ole P Erlandsen...

Par conséquent je te re-propose le GetOpenFile qui, moyennant un petit bidouillage peut facilement partir sur différents drives. Mais qui au moins fonctionnera sous toutes les versions !

L'idéal serait de passer par un UserForm ayant les Drives sur une ListBox mais là je file.

Voici déjà un début de base de travail :

Sub OnOuvreOnCopieOnFerme()
Dim WB As Workbook, WS As Worksheet
Dim TheFile As Variant
Dim TempDir As String, TempDrive As String
Dim UserDir As String, UserDrive As String
Dim ThePath As String, TheString As String

TheString = "MOVE"

UserDrive = Left(CurDir, 1) 'On Mémorise les Paramètres du User
UserDir = CurDir

TempDrive = InputBox("Select the Drive")

ChDrive TempDrive
ThePath = TempDrive & ":\"
ChDir ThePath

TheFile = Application.GetOpenFilename("Excel Files(*.xls),*.xls")
If TheFile = False Then 'Si on ferme le GetOpenFile
ChDrive UserDrive
ChDir UserDir
Exit Sub
End If

If InStr(UCase(TheFile), UCase(TheString)) > 0 Then

Set WB = Workbooks.Open(TheFile)
Set WS = WB.Worksheets(TheString)

With ThisWorkbook.Worksheets(TheString)
.Range("C13:I15").Value = WS.Range("C13:I15").Value
.Range("I6:I9").Value = WS.Range("I6:I9").Value
'etc etc etc de ta macro
End With

WB.Close False

End If

ChDrive UserDrive 'On remet les paramètres du User (comme çà il est content ce pauvre User !!)
ChDir UserDir

End Sub

Bon Courage et bon appétit là je file !!

@+Thierry

 

[thombar]

Merci beaucoup Thierry,

En m'inspirant de tes conseils et en faisant quelques recherches complémentaires, voici maintenant à quoi ressemble mon code :
(je n'ai pas encore testé sous Excel Xp, mais j'imagine que grâce à GetOpenFilename, j'ai la clé de la compatibilité....non ?)

Sub MAMACRO()

Dim fn As Variant
fn = Application.GetOpenFilename("Excel-files,*.xls", 1, "Sélectionnez une fiche MOVE.", , False)
If TypeName(fn) = "Boolean" Then Exit Sub

Range("A59").Value = fn
If Range("A59").Find("MOVE_20") Is Nothing Then ' je me sers de ceci pour vérifier que l'on utilise bien une fiche dont le nom contient MOVE_20
Rap = MsgBox("Le fichier que vous avez sélectionné n'est pas une fiche MOVE valide. Veuillez recommencer.", vbYes)
Exit Sub
Else:

Dim wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(fn, True, True)
With ThisWorkbook.Worksheets("MOVE")
.Protect UserInterfaceOnly:=True
.EnableSelection = xlUnlockedCells
.Range("C13:I15").Value = wb.Worksheets("MOVE").Range("C13:I15").Value
.Range("I6:I9").Value = wb.Worksheets("MOVE").Range("I6:I9").Value
.Range("D1928").Value = wb.Worksheets("MOVE").Range("D1928").Value
.Range("D5455").Value = wb.Worksheets("MOVE").Range("D5455").Value
.Range("A57").Value = wb.Worksheets("MOVE").Range("A57").Value
.Range("A58").Value = wb.Worksheets("MOVE").Range("A58").Value
.Range("I19:I28").Value = wb.Worksheets("MOVE").Range("I19:I28").Value
.Range("I30").Value = wb.Worksheets("MOVE").Range("I30").Value
.Range("I54:I55").Value = wb.Worksheets("MOVE").Range("I54:I55").Value
.Range("F57").Value = wb.Worksheets("MOVE").Range("F57").Value

End With
wb.Close False
Set wb = Nothing
Application.ScreenUpdating = True

With Worksheets("MOVE")
.Protect UserInterfaceOnly:=True
.EnableSelection = xlUnlockedCells
End With

End If
End Sub


A+

 

[@+Thierry]

Re Thombar, le Forum

Oui Thombar j'ai testé ma proposition sous XP, donc çà devrait rouler.

Par contre il est inutile de faire :

Range("A59").Value = fn
If Range("A59").Find("MOVE_20") Is Nothing Then ' je me sers de ceci pour vérifier que l'on utilise bien une fiche dont le nom contient MOVE_20
Rap = MsgBox("Le fichier que vous avez sélectionné n'est pas une fiche MOVE valide. Veuillez recommencer.", vbYes)
Exit Sub
Else:

Ce que je te proposais, remplaçait l'écriture dans une cellule et un Find sur cette cellule (code, ceci dit en passant offert gracieusement par LN, Amiral As Long !!

If InStr(UCase(TheFile), UCase(TheString)) > 0 Then

Et si tu veux à tout prix un message alors en fin de macro tu le mets dans un Else juste après le Wb.Close False

Par ailleurs le Set WS = WB.Worksheets(TheString) te permettait d'éviter de faire référence 10 fois à wb.Worksheets("MOVE")...

Une dernière remarque, je pensais que tu avais besoin de changer de Drive (mapping Network), donc le "sbinz" que j'ai fait pour le ChDrive et ChDir était pour ceci...

Ah aussi le GetOpenFile peut se tester simplement If X = False sans avoir besoin de faire référence "If TypeName", puisqu'il est Variant à double status en fonction du choix du User.

Mais si tu es content et que çà fonctionne c'est le principal !

Bonne Fin de Journée
@+Thierry

 

[thombar]

Tu as tout à fait raison, je vais alléger un peu ce code. Je m'étais empressé de donner ces bonnes nouvelles pour te remercier de ta rapidité, et ton talent !!!

PS : je conserve le Range("A59").Value = fn, car j'ai besoin de vérifier si l'utilisateur se sert souvent de la consultation.....


A bientôt le forum !!!!!