Macro Version 32bits ne fonctionne plus sous Excel 2010-2013

Bonjour,

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

Le dimanche 11 octobre 2020 à 22:47:31 UTC+2, MichD a écrit  :

Bonjour,

Je n'ai pas testé puisque je n'ai pas le code contenu dans ce fichie r.

Dans le haut du module standard où tu déclares l'API, tu la rem places
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/compatib ility-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

Bonjour,

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

Le dimanche 11 octobre 2020 à 23:49:34 UTC+2, MichD a écrit  :

Bonjour,

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 Ex cel 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 do nné,
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

Essaie ce fichier : https://www.cjoint.com/c/JJmu4gzHAMj

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

Le lundi 12 octobre 2020 à 22:59:55 UTC+2, MichD a écrit :

Essaie ce fichier : https://www.cjoint.com/c/JJmu4gzHAMj

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ére nce à des
données sur ton ordinateur (fichiers) que je n'ai pas).

MichD

Le 13/10/20 à 16:07, mcl...@live.fr a écrit :

Le lundi 12 octobre 2020 à 22:59:55 UTC+2, MichD a écrit :

Essaie ce fichier : https://www.cjoint.com/c/JJmu4gzHAMj

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

Bonsoir MichD,

J'ai testé le fichier mais pas d'anomalie.
Par contre le lien hyper texte souhaité lorsqu'il est bien archivé dans le bon répertoire ne fonctionne pas...
je te remets le fichier exemple que tu m'as donné...
https://www.cjoint.com/c/JJnt1vWcRYS

Dans la feuille excel parametre je definie le repertoire de stockage des fichiers techniques
Cela est repris dans ta macro automatiquement
dans la feuille BaseTech, les collègues saisissent en
B1= reference piece
C1 = nom de la pièce
D1 = type de piece

il faudrait qu'excel "scanne le repertoire d'archivage definit en parametre
et qd il trouve par exemple
b1-c1-d1.PDF, il fasse le lien en J1
b1-c1-d1.doc, il fasse le lien en I1

On peut avoir ainsi plusieurs dizaines de références voir au-dela...
Suis-je assez clair ?

Merci d'avance

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

Bonjour,

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

Le mercredi 14 octobre 2020 à 13:17:33 UTC+2, MichD a écrit  :

Bonjour,

Ta demande a changé et quelqu'un a modifié le code et ce dernie r 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 son t
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

effectivement cela a été modifié !
je recherche l'original et excel me fait une erreur sur l'API...

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