Discussion :

[ciboulette0612]

Bonjour

Je cherche une macro qui me permette de lister les images jpeg au sein d'une séquence
Première colonne "image début" : FRAD069_26_4E_17520_01_0001.JPG
Deuxième colonne "image de fin" FRAD069_26_4E_17520_01_0004.JPG

Et je souhaiterai une macro qui puisse, dans le 3e colonne me transformer mes 2 colonnes en : FRAD069_26_4E_17520_01_0001.JPG#FRAD069_26_4E_17520_01_0002.JPG#FRAD069_26_4E_17520_01_0003.JPG#FRAD069_26_4E_17520_01_0004.JPG


Merci beaucoup pour votre aide
Laurence

[E KERGRESSE]

Bonjour,

En supposant que la racine soit la même :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function AssemblerImages(ByVal NomDebut As String, ByVal NomFin As String) As String
 
Dim TabDebut As Variant, TabFin As Variant
Dim PhotoDebut As Variant, PhotoFin As Variant
Dim Racine As String
Dim I As Integer
 
    AssemblerImages = ""
 
    TabDebut = Split(Split(NomDebut, ".JPG")(0), "_")
    TabFin = Split(Split(NomFin, ".JPG")(0), "_")
    PhotoDebut = Val(TabDebut(UBound(TabDebut)))
    PhotoFin = Val(TabFin(UBound(TabFin)))
 
    Racine = ""
    For I = LBound(TabDebut) To UBound(TabDebut) - 1
        Racine = Racine & TabDebut(I) & "_"
    Next I
 
    For I = PhotoDebut To PhotoFin
        AssemblerImages = AssemblerImages & Racine & Format(I, "0000") & ".JPG" & "#"
    Next I
    AssemblerImages = Mid(AssemblerImages, 1, Len(AssemblerImages) - 1)
 
End Function

[Franc]

Salut, voici sous forme de sub pour affecter à un bouton par exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub lister_images_jpeg()
    Dim debut As String
    Dim fin As String
    Dim debut_num As Long
    Dim fin_num As Long
    Dim i As Long, j As Long
    Dim resultat As String
    Dim liste_noms() As String
 
    ' Récupérer la dernière ligne de la feuille active
    Dim last_row As Long
    last_row = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 
    ' Boucler sur chaque ligne à partir de la deuxième
    For i = 2 To last_row
        ' Récupérer les noms de fichier de début et de fin
        debut = ActiveSheet.Cells(i, 1).Value
        fin = ActiveSheet.Cells(i, 2).Value
 
        ' Extraire les numéros de séquence de début et de fin
        debut_num = CLng(Mid(debut, InStrRev(debut, "_") + 1, 4))
        fin_num = CLng(Mid(fin, InStrRev(fin, "_") + 1, 4))
 
        ' Générer la liste des noms de fichier
        ReDim liste_noms(debut_num To fin_num)
        liste_noms(debut_num) = debut & "#"
        For j = debut_num + 1 To fin_num - 1
            liste_noms(j) = Left(debut, InStrRev(debut, "_")) & Format(j, "0000") & ".jpg#"
        Next j
        liste_noms(fin_num) = fin & "#"
        ' Concaténer la liste des noms de fichier avec un retour à la ligne
        resultat = Join(liste_noms, vbCrLf)
 
        ' Écrire le résultat dans la troisième colonne et formater la cellule
        With ActiveSheet.Cells(i, 3)
            .Value = resultat
            .WrapText = True
            .Rows.AutoFit
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .ColumnWidth = Len(resultat) / (fin_num - debut_num + 1) + 3
        End With
 
        ' Formater les cellules A et B pour les centrer sur la hauteur
        With ActiveSheet.Cells(i, 1)
            .VerticalAlignment = xlCenter
        End With
 
        With ActiveSheet.Cells(i, 2)
            .VerticalAlignment = xlCenter
        End With
    Next i
End Sub