pour 10 images ça marche mais...

[Leroux]

Bonjour à tous. Et par avance Merci pour votre aide.
ce code est initialement prévu pour manipuler 11 images
Comment empecher les erreurs d'execution si :
je manipule moins de dix image ?
Pour les deux premières je souhaiterai également que ce soit l'image 000.jpg
qui s'affiche en premier car actuellement c'est 001.jpg

Private Sub CommandButton8_Click()
Dim image(10) As String
Dim numero As Byte
image(0) = "C:\MesImages\000.JPG"
image(1) = "C:\MesImages\001.JPG"
image(2) = "C:\MesImages\002.JPG"
image(3) = "C:\MesImages\003.JPG"
image(4) = "C:\MesImages\004.JPG"
image(5) = "C:\MesImages\005.JPG"
image(6) = "C:\MesImages\006.JPG"
image(7) = "C:\MesImages\007.JPG"
image(8) = "C:\MesImages\008.JPG"
image(9) = "C:\MesImages\009.JPG"
image(10) = "C:\MesImages\010.JPG"
numero = Range("CA4").Value
If numero = 0 Then numero = 10
numero = numero - 1
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Private Sub CommandButton9_Click()
Dim image(10) As String
Dim numero As Byte
image(0) = "C:\MesImages\000.JPG"
image(1) = "C:\MesImages\001.JPG"
image(2) = "C:\MesImages\002.JPG"
image(3) = "C:\MesImages\003.JPG"
image(4) = "C:\MesImages\004.JPG"
image(5) = "C:\MesImages\005.JPG"
image(6) = "C:\MesImages\006.JPG"
image(7) = "C:\MesImages\007.JPG"
image(8) = "C:\MesImages\008.JPG"
image(9) = "C:\MesImages\009.JPG"
image(10) = "C:\MesImages\010.JPG"
numero = Range("CA4").Value
numero = numero + 1
If numero > 10 Then numero = 0
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Sub AffichVignettes()
'Affiche les images du répertoire sous forme de vignettes sur page "Dégivrage"
Application.ScreenUpdating = False
Sheets("Vignettes").Select
MonImage$ = "C:\MesImages\000.jpg"
ActiveSheet.Shapes("Rectangle 3").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\001.jpg"
ActiveSheet.Shapes("Rectangle 4").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\002.jpg"
ActiveSheet.Shapes("Rectangle 5").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\003.jpg"
ActiveSheet.Shapes("Rectangle 6").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\004.jpg"
ActiveSheet.Shapes("Rectangle 7").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\005.jpg"
ActiveSheet.Shapes("Rectangle 8").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\006.jpg"
ActiveSheet.Shapes("Rectangle 9").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\007.jpg"
ActiveSheet.Shapes("Rectangle 10").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\008.jpg"
ActiveSheet.Shapes("Rectangle 11").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\009.jpg"
ActiveSheet.Shapes("Rectangle 12").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
MonImage$ = "C:\MesImages\010.jpg"
ActiveSheet.Shapes("Rectangle 13").Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
Range("A1").Select
Sheets("Dessin").Select
Range("C1").Select

End With
End Sub

 

[jaccard]

Hello,
- en utilisant une constante intDerniereImage indiquant le dernier numero d'image
- en inversant le test numero=0 et numéro-1 dans CommandButton8_Click
- en utilisant des boucles for-next

cela devrait fonctionner (je n'ai pas essayé):


Const intDerniereImage = 5

Private Sub CommandButton8_Click()
Dim image(intDerniereImage) As String
Dim numero As Byte
For numero = 0 To intDerniereImage
image(numero) = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
Next numero
numero = Range("CA4").Value
numero = numero - 1
If numero < 0 Then numero = intDerniereImage
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Private Sub CommandButton9_Click()
Dim image(10) As String
Dim numero As Byte
For numero = 0 To intDerniereImage
image(numero) = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
Next numero
numero = Range("CA4").Value
numero = numero + 1
If numero > intDerniereImage Then numero = 0
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Sub AffichVignettes()
'Affiche les images du répertoire sous forme de vignettes sur page "Dégivrage"
Application.ScreenUpdating = False
Sheets("Vignettes").Select
For numero = 0 To intDerniereImage
MonImage$ = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
ActiveSheet.Shapes("Rectangle " & numero + 3).Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
Next numero

Range("A1").Select
Sheets("Dessin").Select
Range("C1").Select
End Sub


cette macro peut être améloiré en comptant directement tes images xxx.JPg avec application.filesearch seulement si tous les jpeg du répertoire doivent être traité par cette macro

dom;-)

 

[Leroux]

Merci pout ton aide.
Peux tu m'aiguiller sur la méthode "application.filesearch "car effectivement, tous les jpeg de mon repertoire sont traitées.
Merci A+
Leroux

 

[jaccard]

Hello, j'ai ajouté une fonction en fin de ta macro utilisant application.filesearch
le tableau image est dimensionné avec ReDim car ce n'est plus une constante. (d'ailleurs j'avais fait une erreur précedemment en laissant un Dim image(10)

ReDom ;-)

Private Sub CommandButton8_Click()
Dim numero, intDerniereImage As Byte
intDerniereImage = IndexDerniereImage
ReDim image(10) As String
For numero = 0 To intDerniereImage
image(numero) = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
Next numero
numero = Range("CA4").Value
numero = numero - 1
If numero < 0 Then numero = intDerniereImage
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Private Sub CommandButton9_Click()
Dim numero, intDerniereImage As Byte
intDerniereImage = IndexDerniereImage
ReDim image(10) As String
For numero = 0 To intDerniereImage
image(numero) = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
Next numero
numero = Range("CA4").Value
numero = numero + 1
If numero > intDerniereImage Then numero = 0
Range("CA4").Value = numero
ActiveSheet.Shapes("Rectangle 1827").Select
Selection.ShapeRange.Fill.UserPicture "" & image(numero)
Range("D1").Activate
Range("CA6") = Mid(image(numero), 26, Len(image(numero)))
End Sub

Sub AffichVignettes()
'Affiche les images du répertoire sous forme de vignettes sur page "Dégivrage"
Dim numero, intDerniereImage As Byte

Application.ScreenUpdating = False
Sheets("Vignettes").Select
intDerniereImage = IndexDerniereImage
For numero = 0 To intDerniereImage
MonImage$ = "C:\MesImages\" & String(3 - Len(numero), "0") & numero & ".JPG"
ActiveSheet.Shapes("Rectangle " & numero + 3).Select
With Selection.ShapeRange.Fill
.Solid
.UserPicture MonImage
End With
Next numero
Range("A1").Select
Sheets("Dessin").Select
Range("C1").Select
End Sub

Function IndexDerniereImage()
With Application.FileSearch
.LookIn = "c:\MesImages"
.FileName = "???.JPG"
.Execute
IndexDerniereImage = .FoundFiles.Count - 1
End With
End Function