Macro Version 32bits ne fonctionne plus sous Excel 2010-2013
Le
mcl...
Bonsoir,
MichD vous m'aviez fait une macro absolument formidable qui scanner un rep=
értoire pour activer ou non un lien hypertexte si l'objet était t=
rouvé.
On vient de passer sous excel 2010 et encore bientôt sous excel 2013.
Et lorsque je lance ma feuille excel voici le message d'erreur que j'ai.
MichD puis-je vous demander votre aide ?
La partie du code mais si besoin je pourrais monter le fichier complet.
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Merci pour votre réponse.
John97L
MichD vous m'aviez fait une macro absolument formidable qui scanner un rep=
értoire pour activer ou non un lien hypertexte si l'objet était t=
rouvé.
On vient de passer sous excel 2010 et encore bientôt sous excel 2013.
Et lorsque je lance ma feuille excel voici le message d'erreur que j'ai.
MichD puis-je vous demander votre aide ?
La partie du code mais si besoin je pourrais monter le fichier complet.
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Merci pour votre réponse.
John97L
Je n'ai pas testé puisque je n'ai pas le code contenu dans ce fichier.
Dans le haut du module standard où tu déclares l'API, tu la remplaces
par ceci :
'Si le fichier doit exécuter les macros dans des versions
'd'Excel inférieur à Excel 10 et aussi dans Excel 10 ou
'ultérieures, on doit utiliser la compilation conditionnelle.
'Dans ce cas, observe bien le type des variables, certains
d'entre eux diffèrent selon les versions 32 ou 64 bits.
'pour plus d'information, consulte ce site internet :
'https://docs.microsoft.com/Fr-Fr/office/client-developer/shared/compatibility-between-the-32-bit-and-64-bit-versions-of-office
'-----------------------------------------------------------------
'pour les versions plus anciennes qu'Excel 2010
#If Not VBA7 Then
'Pour les versions plus anciennes, on doit utiliser
'le "compilateur conditionnel " Win64"
'pour différencier une version Office 32 ou 64 bits
#If Not Win64 Then
Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#End If
#Else
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#End If
'-----------------------------------------------------------------
MichD
Voici le code du module 1
Sub Check_Fichier(C As Range)
Dim DerLig As Long, X As String, Y As String, Compteur As Long
Dim T(), Elt As Variant, A As Long, Arr(0 To 2), Ar As Variant
Dim K As String, S As Variant
Arr(0) = """xls"", ""xlsx"", ""xlsm"", ""xlsb"""
Arr(1) = """doc"", ""docx"", ""docm"""
With Worksheets("Parametres")
T = .Range("c4:C" & .Range("A450").End(xlUp).Row).Value
End With
A = C.Row
On Error Resume Next
With Worksheets("baseTECH")
For Each Elt In T
For Compteur = 1 To 3
If Compteur = 1 Then
X = Elt & .Range("G" & A) & "-" & .Range("B" & A)
Else
X = Elt & .Range("H" & A) & "-" & .Range("B" & A)
End If
If X <> "" Then
Y = Dir(X & ".pdf")
If Y <> "" Then
With .Range("K" & A)
.Value = Elt & Y
.Interior.Color = vbGreen
.Style = "Followed Hyperlink"
End With
End If
Y = Dir(X & ".*")
If Y <> "" Then
K = Split(Y, ".")(UBound(Split(Y, ".")))
S = Application.Match("*" & K & "*", Arr, 0)
If IsNumeric(S) Then
Select Case S
Case 1
With .Range("i" & A)
.Value = Elt & Y
.Interior.Color = vbGreen
.Style = "Followed Hyperlink"
End With
Case 2
With .Range("J" & A)
.Value = Elt & Y
.Interior.Color = vbGreen
.Style = "Followed Hyperlink"
End With
End Select
Else
Err = 0
End If
End If
End If
Next
Compteur = 1
Next
End With
End Sub
'Sub Vérification_sur_Ouverture()
'Dim Rg As Range, C As Range, DerLig As Long
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'With Worksheets("baseVTECH")
' DerLig = .Range("B450").End(xlUp).Row
' Set Rg = .Range("B2:B" & DerLig)
' For Each C In Rg.Cells
' If C <> "" Then
' Call Check_Fichier(C)
' End If
' Next
'End With
'Application.EnableEvents = True
'Application.ScreenUpdating = True
'End Sub
et dans le module 2
Sub recherche(mot)
Sheets("recherche").Range("A14:P450").Clear
ligne = 14
For Each ws In Sheets
If ws.Name <> "recherche" Then
With ws.Cells
Set C = .Find(mot, LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
ws.Rows(C.Row).Copy Destination:=Sheets("recherche").Cells(lign e, 1)
ligne = ligne + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
trouve = True
End If
End With
End If
Next ws
X = Sheets("recherche").Range("B450").End(xlUp).Row
If X > 14 Then
For n = X To 15 Step -1
For m = 1 To 7
xx = xx & Sheets("recherche").Cells(n, m)
yy = yy & Sheets("recherche").Cells(n - 1, m)
Next m
If yy = xx Then Sheets("recherche").Rows(n).Delete
xx = ""
yy = ""
Next n
End If
If Not trouve Then MsgBox ("Le mot " & mot & " n'a pas été trouv é dans la base-Tech")
End Sub
La macro que tu as publiée n'utilise pas d'API. Par conséquent, elle
devrait fonctionner correctement sous Excel 2010 et les versions plus
récentes. D'ailleurs elle a été élaborée sous Excel 2016.
Tu dois avoir une autre macro qui utilise l'API de Windows dans ton
classeur.
Cela étant, si tu substitues l'API du classeur par ce que je t'ai donné,
est-ce que cela résout ton problème?
MichD
Bonsoir MichD,
J'ai mis un vue partiel du fichier qui fonctionnait jusqu'à maintenant .
Suite à migration et evolution nous avons des machines avec excel 2010 et d'autres avec excel 2013...
Je mets le fichier
https://www.cjoint.com/c/JJmujEbl3AS
Un grand merci d'avance pour votre aide !
John97l
Si cela plante, dis-moi, quelle ligne est soulignée en jaune?
Quel est le message d'erreur?
Je ne peux pas tout tester, car ces procédures font référence à des
données sur ton ordinateur (fichiers) que je n'ai pas).
MichD
A ) Si l'autre fichier fonctionnait bien, moi, je n'ai rien changé au
niveau du code dans ce fichier.
B ) La seule modification effectuée est la manière dont la déclaration
de l'API de Windows est faite dans le haut du module1 afin de permettre
toutes les versions d'Excel 1997 à 2019 d'utiliser l'API de Windows
selon les conventions des différentes versions.
C ) Je ne me souviens pas des détails de la toute première version que
je t'ai donnée, mais lorsque je regarde le code et la présentation de la
structure du fichier, il n'y a pas de correspondance.
D ) Dans la procédure, il n'y a aucune ligne de code qui crée les liens
hypertextes. En lieu et place, celui qui a modifié le code utilise la
propriété "Style" d'un objet "range" et applique format "Hypertexte" à
la cellule, mais cela ne crée pas un lien hypertexte pour autant.
E ) Le code a été modifié par quelqu'un d'autre.
F ) Conclusion, il faudrait que je corrige substantiellement le code
actuel. Où est le fichier original que je t'ai transmis la première
fois? Est-ce que je peux en avoir une copie?
Dans le nouveau fichier, qu'est-ce qui forme le nom des fichiers? Donne
un exemple concret de la composition des noms de fichiers.
Lorsque le fichier existe, dans quelle colonne doit apparaître le lien
hypertexte?
Est-ce que tous les fichiers se retrouvent dans ce répertoire X:900 -
doctech ?
Ne te gêne pas pour ajouter les compléments d'information que tu juges
approprier.
MichD
Ta demande a changé et quelqu'un a modifié le code et ce dernier n'est
plus fonctionnel.
A ) Copie le code suivant dans le module de la feuille "BaseTech".
B ) Si les 3 colonnes B, C, et D contiennent du texte qui correspond au
nom du fichier recherché dans le répertoire de la cellule C4 de la
feuille "Parametres" alors un lien hypertexte sera créé dans la colonne
M, sur la même ligne.
C ) Le lien hypertexte est créé seulement si les 3 cellules sont
remplies, c'est-à-dire, aucune n'est laissée vide.
'---------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, Chemin As String
Dim X As String, Fichier As String
Chemin = Worksheets("Parametres").Range("C4")
With Me
Set Rg = Intersect(Target, .Range("B2:D" &
.Range("B65536").End(xlUp).Row))
End With
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
If Application.WorksheetFunction.CountA(Range("B" &
C.Row).Resize(3)) = 3 Then
Fichier = Range("B" & C.Row) & " - " & _
Range("C" & C.Row) & " - " & _
Range("D" & C.Row) & ".pdf"
X = Dir(Chemin & Fichier)
If X <> "" Then
With Range("M" & C.Row)
.ClearContents
.Hyperlinks.Add Anchor:=Range("M" & C.Row),
Address:=Chemin & X
End With
Else
Range("M" & C.Row).ClearContents
End If
End If
Next
Application.EnableEvents = True
End If
End Sub
'---------------------------------------------------
MichD
Bonsoir MichD,
effectivement cela a été modifié !
je recherche l'original et excel me fait une erreur sur l'API...
Merci pour ton aide...je reviens vers toi au plus vite !
Mclain
Pour ta dernière question, tu n'as pas besoin de l'API de Windows.
La dernière procédure publiée fait le travail demandé. Pas besoin de
rien d'autre!
MichD