OVH Cloud OVH Cloud

Otimisation code et appel de fonction

2 réponses
Avatar
kerr2
Bonjour,

Afin d'optimiser la macro (module 1) que j'utilise, j'ai crée une fonction
(module 2) .
Module 1: ImportImagesSousRep
Module 2: ImportImages

Quand je n'optimise pas le code (en créant et appelant la fonction
ImportImages) cela fonctionne.
Quand j'optimise, en mode debugage, les conditions de la fonction
ImportImages (module 2), ne sont plus remplies
Il n'y a pas d'import des photos.

Je n'ai pourtant rien fait d'autre que remplacer un bloc par une fonction.
J'ai indiqué ci dessous par des flèches *=> les conditions non remplies
Il est important que l'instruction Range("c2").Select avant l'appel de la
fonction soit effectué. J'ai l'impression que c'est la le hic.

Si quelqu'un peut m'éclairer.
En vous remerciant par avance.


Module 1:
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "\Photos " & NomOnglet & "\" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
=> ImportImages
Encadrer
End Sub

Module 2:
Sub ImportImages()
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
*=> If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
*=> If Dir(chemin & nf1) <> "" Then
Set monimage =
ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height
+ 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



Sans optimiser cela donne:

Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "\Photos " & NomOnglet & "\" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin &
nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
Encadrer
End Sub

2 réponses

Avatar
Nicolas B.
Salut,

Les variables que tu utilises dans la procédure en module 1 ont une
portée limitée à ladite procédure. Cela signifie par exemple que tu
renseignes la varible chemin dans la première procédure, la variable
chemin de la deuxième procédure sera vide (ce ne sont en fait pas les
mêmes variables).

Pour mieux comprendre, observe le résultat de l'exécution de Proc1:

sub Proc1()
dim s as string
s = "toto"
msgbox s
Proc2
end sub

sub Proc2()
msgbox s
end sub


Voici une solution pour passer des variables entre procédures :

sub Proc3()
dim s as string
s = "toto"
msgbox s
Proc4 s
end sub

sub Proc4(var as string)
msgbox var
end sub


Dans ton cas ça va donner quelque chose du genre :

Sub ImportImagesSousRep()
'...
ImportImages chemin
'...
end sub

Sub ImportImages(chemin as string)
'...
end sub


Une autre méthode est de déclarer tes variables publiques en début de
module. Ainsi, si tu ne rajoutes dans ton code avant la ligne "Sub..."
la ligne suivante (dans un des deux modules)
public chemin as string
ça devrait aussi fonctionner (mais c'est moins élégant que la première
solution :-)


A+
Nicolas B.

Bonjour,

Afin d'optimiser la macro (module 1) que j'utilise, j'ai crée une fonction
(module 2) .
Module 1: ImportImagesSousRep
Module 2: ImportImages

Quand je n'optimise pas le code (en créant et appelant la fonction
ImportImages) cela fonctionne.
Quand j'optimise, en mode debugage, les conditions de la fonction
ImportImages (module 2), ne sont plus remplies
Il n'y a pas d'import des photos.

Je n'ai pourtant rien fait d'autre que remplacer un bloc par une fonction.
J'ai indiqué ci dessous par des flèches *=> les conditions non remplies
Il est important que l'instruction Range("c2").Select avant l'appel de la
fonction soit effectué. J'ai l'impression que c'est la le hic.

Si quelqu'un peut m'éclairer.
En vous remerciant par avance.


Module 1:
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
=> ImportImages
Encadrer
End Sub

Module 2:
Sub ImportImages()
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
*=> If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
*=> If Dir(chemin & nf1) <> "" Then
Set monimage =
ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height
+ 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



Sans optimiser cela donne:

Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin &
nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
Encadrer
End Sub




Avatar
kerr2
Merci Nicolas.

J'ai décortiqué tes exemples et mis en application.
Cela fonctionne.

Un grand merci


Sub ImportImagesSousRep()
=> Dim chemin As String
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
=> ImportImages chemin
Encadrer
End Sub


=> Sub ImportImages(chemin As String)
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

























"Nicolas B." a écrit dans le message
de news:
Salut,

Les variables que tu utilises dans la procédure en module 1 ont une portée
limitée à ladite procédure. Cela signifie par exemple que tu renseignes la
varible chemin dans la première procédure, la variable chemin de la
deuxième procédure sera vide (ce ne sont en fait pas les mêmes variables).

Pour mieux comprendre, observe le résultat de l'exécution de Proc1:

sub Proc1()
dim s as string
s = "toto"
msgbox s
Proc2
end sub

sub Proc2()
msgbox s
end sub


Voici une solution pour passer des variables entre procédures :

sub Proc3()
dim s as string
s = "toto"
msgbox s
Proc4 s
end sub

sub Proc4(var as string)
msgbox var
end sub


Dans ton cas ça va donner quelque chose du genre :

Sub ImportImagesSousRep()
'...
ImportImages chemin
'...
end sub

Sub ImportImages(chemin as string)
'...
end sub


Une autre méthode est de déclarer tes variables publiques en début de
module. Ainsi, si tu ne rajoutes dans ton code avant la ligne "Sub..."
la ligne suivante (dans un des deux modules)
public chemin as string
ça devrait aussi fonctionner (mais c'est moins élégant que la première
solution :-)


A+
Nicolas B.

Bonjour,

Afin d'optimiser la macro (module 1) que j'utilise, j'ai crée une
fonction (module 2) .
Module 1: ImportImagesSousRep
Module 2: ImportImages

Quand je n'optimise pas le code (en créant et appelant la fonction
ImportImages) cela fonctionne.
Quand j'optimise, en mode debugage, les conditions de la fonction
ImportImages (module 2), ne sont plus remplies
Il n'y a pas d'import des photos.

Je n'ai pourtant rien fait d'autre que remplacer un bloc par une
fonction.
J'ai indiqué ci dessous par des flèches *=> les conditions non remplies
Il est important que l'instruction Range("c2").Select avant l'appel de
la fonction soit effectué. J'ai l'impression que c'est la le hic.

Si quelqu'un peut m'éclairer.
En vous remerciant par avance.


Module 1:
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
=> ImportImages
Encadrer
End Sub

Module 2:
Sub ImportImages()
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
*=> If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin &
nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
*=> If Dir(chemin & nf1) <> "" Then
Set monimage =
ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight =
monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



Sans optimiser cela donne:

Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
Range("c2").Select
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin &
nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
Encadrer
End Sub