Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

[lcoulon]

Bonjour

Savez vous si il est possible de créer via une macro , une photographie du contenu d'une cellule en fichier image tel que BMP ou JPEG

Mon but serait de pouvoir créer des fichiers images de cellules contenant des codes barres pour ensuite les imprimer avec un soft ayant plus de souplesse pour la mise en page.

Merci a vous

 

[Excel_lent]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Bonjour lcoulon et aux autres.

Vois si cette macro (je ne me souviens plus de l'origine) peut t'être utile.
Elle permet de créer, en Feuil2 ici, une image de la plage sélectionnée.

 

[lcoulon]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

c'est vraiment pas mal, comment pourrait on y ajouter l'option " enregistrer l'image sous " et sauvegarder l'image en JPEG sur le disque ?

 

[Staple1600]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Bonjour à tous


Sans passer par une macro

Tu sélectionnes ta cellule ou plage de cellules
tout en appuyany sur Shift

Ensuite Edition/Copier comme une image

Edition/Coller


Ce qui donne avec l'enregistreur de macro (par exemple)

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 16/03/2008 
'
    Range("A1").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("A3").Select
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= _
        False, DisplayAsIcon:=False
    Range("A4").Select
End Sub

Et en modifidant le code crée:

Sub Macro1_2()
'copie la selection en cours
Selection.CopyPicture 
Range("A3").Select
ActiveSheet.PasteSpecial "Image (métafichier amélioré)"
Range("A4").Select
End Sub

 

[Staple1600]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Re


En plus propre et plus complet

Pour copier les cellules en image

Sub ImagePlageCellules()
'auteur:SilkyRoad
    'La plage de cellules A1:B5 est copiée dans le Presse-papiers en tant qu'image.
    Worksheets("Feuil1").Range("A1:B5").CopyPicture
    'L'image est collée dans la feuille active
    Worksheets("Feuil1").Paste
    ' renomme l'image
    Selection.Name = "Image A1:B5"
End Sub

Pour enregistrer les images dans un répertoire
EDIT: ne fonctionne pas avec les Shapes

Sub ExtractionImagesFeuille()
'auteur:SilkyRoad
    Dim Pict As Picture
    Dim Nb As Byte
    
    Application.ScreenUpdating = False
    
    For Each Pict In Worksheets("Feuil1").Pictures
        Pict.CopyPicture 'copie l'image
        
        With Worksheets("Feuil1").ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
            .Paste 'colle l'image dans un graphique temporaire
            'Sauvegarde au format image, dans le même répertoire que ce classeur.
            .Export ThisWorkbook.Path & "\" & Pict.Name & ".gif", "GIF"
        End With
        
        'Supprime le graphique
        Nb = Worksheets("Feuil1").ChartObjects.Count
        Worksheets("Feuil1").ChartObjects(Nb).Delete
    Next Pict
    
    Application.ScreenUpdating = True
End Sub

Plus de détails ici.

 

[lcoulon]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Merci je vais étudier cela.

Est ce que l'enregistrement dans un fichier image sera 1 fichier pour toute la plage de cellules, ou chaque cellule se verra enregistrée dans un fichier individuel ? ( c'est cette option qui m'interresse le plus )

 

[CB60]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

bonsoir
une autre façon de faire
création d'un classeur à chaque copie

Sub copie()
'
' copie Macro
' Macro enregistrée le 16/03/2008 par Bruno
Set choix = Application.InputBox(prompt:="Sélectionnez la plage de cellules.", _
Title:="Plage de cellules", Left:=500, Top:=300, Type:=8)
choix.Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Workbooks.Add
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:= _
        False, DisplayAsIcon:=False
End Sub

 

[Staple1600]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Re



Voici une autre solution

[COLOR=Black]Public [/COLOR][COLOR=Black]Sub SaveRangeAsImage()
 'auteur: cafeine
[URL="http://www.developpez.net/forums/showpost.php?p=1636854&postcount=1"]'source[/URL]
[/COLOR]  [COLOR=Black]Dim r [/COLOR][COLOR=Black]As Range
[/COLOR] [COLOR=Black]Dim x [/COLOR][COLOR=Black]As [/COLOR][COLOR=Black]Integer, y [/COLOR][COLOR=Black]As [/COLOR][COLOR=Black]Integer
[/COLOR] [COLOR=Black]Dim varFullPath [/COLOR][COLOR=Black]As [/COLOR][COLOR=Black]Variant
[/COLOR] [COLOR=Black]Dim Graph [/COLOR][COLOR=Black]As [/COLOR][COLOR=Black]String
 
[/COLOR] [COLOR=Black]' selection de la plage par une InputBox
[/COLOR] [COLOR=Black]Set r = application.InputBox([/COLOR][COLOR=Black]"Sélectionnez la plage à exporter", _
                    [/COLOR][COLOR=Black]"Export Image", Selection.AddressLocal, Type:=[/COLOR][COLOR=Black]8)
 
r.[/COLOR][COLOR=Black]Select
[/COLOR] [COLOR=Black]' copie de la plage en format image grâce à .CopyPicture
Selection.CopyPicture appearance:=xlScreen, Format:=xlBitmap
x = Selection.Width
y = Selection.Height
 
[/COLOR] [COLOR=Black]' on utilise l'objet Chart pour sa facilité d'export 
[/COLOR] [COLOR=Black]' création du graphique
Workbooks.Add ([/COLOR][COLOR=Black]1)
ActiveSheet.Name = [/COLOR][COLOR=Black]"enGIF"
Charts.Add
ActiveChart.ChartType = xl3DArea
ActiveChart.SetSourceData r
ActiveChart.Location xlLocationAsObject, [/COLOR][COLOR=Black]"enGIF"
[/COLOR] [COLOR=Black]' le graph n'est là que comme réceptacle de l'image, on le vide avec .ClearContents
ActiveChart.ChartArea.ClearContents
[/COLOR] [COLOR=Black]' on colle l'image qui réside dans le presse papier
ActiveChart.Paste
 
[/COLOR] [COLOR=Black]' redimensionnement
[/COLOR] [COLOR=Black]' on récupére le nom du graph de la collection Shapes
Graph = [/COLOR][COLOR=Black]Mid(ActiveChart.Name, Len(ActiveSheet.Name) + [/COLOR][COLOR=Black]1)
[/COLOR] [COLOR=Black]' on effectue un redimensionnement
ActiveSheet.Shapes(Graph).ScaleWidth x / ActiveChart.ChartArea.Width, _
            msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(Graph).ScaleHeight y / ActiveChart.ChartArea.Height, _
            msoFalse, msoScaleFromTopLeft
            
[/COLOR] [COLOR=Black]' export
varFullPath = _
application.GetSaveAsFilename([/COLOR][COLOR=Black]"C:\Temp\export-" & Format(Now, [/COLOR][COLOR=Black]"yyyymmddhhnn") & [/COLOR][COLOR=Black]".gif", _
                [/COLOR][COLOR=Black]"Fichiers GIF (*.gif), *.gif")
ActiveChart.Export varFullPath, [/COLOR][COLOR=Black]"GIF"
ActiveChart.Pictures([/COLOR][COLOR=Black]1).Delete
ActiveWorkbook.Close [/COLOR][COLOR=Black]False
    
[/COLOR] [COLOR=Black]End [/COLOR][COLOR=Black]Sub

[/COLOR]

 

[Excel_lent]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Salut lcoulon

...
Mon but serait de pouvoir créer des fichiers images de cellules contenant des codes barres pour ensuite les imprimer avec un soft ayant plus de souplesse pour la mise en page.

Avec les propositions précédentes (salut JM, Bruno) tu sauvegardes l’image sur ton disque puis tu ouvres ton soft et tu insères celle-ci (ce qui suppose que ton soft d’accepte l’insertion d’image).

Pourquoi ne pas travailler avec les 2 programmes ouverts en même temps ? Quand tu as l’image dans la « Feuil2 » d’Excel, un drag and drop suffit pour la déplacer dans le second programme.
Un avantage de cette manipulation (si c’en est un) serait de n’avoir pas à rechercher le fichier en question sur ton disque.
Un inconvénient serait d’avoir à réorganiser ta page avant l’impression, encore que tu aurais à le faire dans tous les cas.
L'idéal serait pour toi, si j'ai bien compris, d'avoir une procédure dans Excel qui fasse tout cela. Mais là, je ne sais pas la contruire et serais attentif aux éventuelles propositions à venir.

 

[guigui76]

Re : Créer un fichier image : BMP, JPEG du contenu d'une cellule ?

Comment puis-je faire pour indiquer le lieu de stockage et de remplacer le précédent enregistrement?
Merci