Discussion :

[ALACO]

Bonjour à tous,

J'avais besoin de convertir des images qui sont en format JPG en format BMP afin qu'elles puissent être utilisées dans une bibliothèque dans le logiciel d'une machine de fabrication (le format BMP étant le seul à être lu sur ce logiciel).
Ce sont des photos d'outils d'usinage pour alimenter la bibliothèque des outils de la machine.
J'avais également besoin de les renommer, et de les mettre dans un autre dossier.
J'ai donc réussi à écrire un petit programme qui fait tout cela (en apparence du moins).

Le problème survient lorsque j'essaie d'utiliser ces images BMP sur le logiciel de destination. Le logiciel ne lit pas l'image, aucun aperçu n'est visible dans la bibliothèque.
Or lorsque la conversion JPG -> BMP est réalisée "manuellement" en enregistrant sous, il n'y a aucun problème de lecture pour le logiciel de destination.
Il doit y avoir une subtilité pour la conversion des images mais je ne connais pas suffisamment le sujet pour voir de quoi il s'agit...
J'ai fait ce programme, car j'ai environ au moins 200 fichiers concernés...
Est-ce que quelqu'un pourrait m'aider svp ?

Merci

Ci-joint le fichier excel dans lequel j'ai les informations utilisées dans le programme.

[kiki29]

Salut, voir peut-être ici ( pas testé )

[kiki29]

Salut, en partant de ce fichier : Liste des fichiers d'un dossier : Win 32/64 Bits

En y ajoutant un module standard avec le code suivant :

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
Option Explicit
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                            (ByVal hwnd As Long, _
                                             ByVal pszPath As String, _
                                             ByVal lngsec As Long) As Long
 
Private Sub ConversionBMP(sJpeg As String, sBmp As String)
Dim Pict As IPictureDisp
    Set Pict = stdole.LoadPicture(sJpeg)
    stdole.SavePicture Pict, sBmp
    Set Pict = Nothing
End Sub
 
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Sub Conversion_JpegBmp()
Dim sJpeg As String, i As Long
Dim sDossierBMP As String, LastRow As Long
Dim FSO As Object, sNomBmp As String
 
    sDossierBMP = ThisWorkbook.Path & "\" & "BMP"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(sDossierBMP) Then FSO.DeleteFolder sDossierBMP, True
    Set FSO = Nothing
 
    CreationDossier sDossierBMP
 
    LastRow = ShParam.Range("B" & Rows.Count).End(xlUp).Row
    If LastRow < RDepart Then Exit Sub
    Application.StatusBar = ""
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For i = RDepart To LastRow
        sJpeg = ShParam.Range("A1") & "\" & ShParam.Range("B" & i)
        sNomBmp = sDossierBMP & "\" & FSO.GetBaseName(sJpeg) & ".bmp"
        ConversionBMP sJpeg, sNomBmp
        Application.StatusBar = i - RDepart + 1 & " / " & LastRow - RDepart + 1
    Next i
    Set FSO = Nothing
    Application.StatusBar = Application.StatusBar & " / Terminé"
End Sub

Ce qui devrait permettre d'aboutir à qqch comme ceci :

[kiki29]

Re, ajouter pour ton fichier ( Téléchargeable ici ) dans son module mJpeg2Bmp

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
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Or Len(sChaine) > 157 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

Dans procédure Conversion_JpegBmp un remplacement

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
	
.....
    'CFD à mettre dans sDossierBMP ?
    sDossierBMP = ThisWorkbook.Path & "\" & "BMP"
.....
    For i = RDepart To LastRow
        sJpeg = ShParam.Range("A1") & "\" & ShParam.Range("B" & i)
        If UCase$(ShParam.Range("A" & i)) = "X" Then
        ' coordonnées cellules changées
            '   CFD & Cells(i, 2) & "-" & Cells(i, 3) & "-" & Cells(i, 1) & "-" & Cells(i, 5) & ".bmp"
            sNomBmp = ShParam.Cells(i, 3) & "-" & ShParam.Cells(i, 4) & "-" & ShParam.Cells(i, 5) & "-" & ShParam.Cells(i, 6) & ".bmp"
            If NomFichierValide(sNomBmp) Then
                If bDoublons Then
                    sNouveauNom = RenommerFichier(sDossierBMP, sNomBmp)
                Else
                    sNouveauNom = sDossierBMP & "\" & sNomBmp
                End If
                ConversionJpegBmp sJpeg, sNouveauNom
                j = j + 1
                Application.StatusBar = j & " / " & LastRow - RDepart + 1
            Else
                With ShParam
                    .Cells(i, 1) = ""
                    .Cells(i, 1).Select
                End With
                MsgBox "Nom fichier invalide", vbOKOnly + vbCritical
                'Exit For
            End If
        End If
    Next i
    .....

[kiki29]

L'ultime version, dans l'attente d'une réaction de ta part.