nommer image pour enregistrement

[jtitin]

bousoir à tous
j'ai récupéré cette super macro sur ce forum et j'aimerais l'adapter.
je voudrais pouvoir enregistrer l'image en lui donnant comme nom la valeur de la dernière cellule écrite colonne F de la feuille "Base" (ex: image1)
ce qui me permetrer enregistrer dans un dossier une nouvelle image sans écraser l'image existante
avant de lancer cette macro il faut faire un Imprim écran

Merci pour votre aide

Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub collage_Image_V02()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String

x = ActiveSheet.Shapes.Count

Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
On Error GoTo c
ActiveSheet.Paste

'verifie si le collage effectué correspond à une image
c:
If x = ActiveSheet.Shapes.Count Then
Application.ScreenUpdating = True
MsgBox "Opération annulée" & vbLf & "Il faut faire Imprim Ecran sur l'application souhaitée"
Exit Sub

Else

Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
monImage = "C:\Documents and Settings\jtitin\Bureau\enregistre_imageJPG\monImage.jpg"

With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
.Paste
.Export monImage, "JPG"
End With

With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.Shapes(ActiveSheet.Shapes.Count).Delete
End With

Application.ScreenUpdating = True

End If

End Sub

 

[jtitin]

Re : nommer image pour enregistrement

re bonsoir

personne n'a une petite réponse à mon problème


merci

 

[MichelXld]

Re : nommer image pour enregistrement

bonjour

Remplace

monImage = "C:\Documents and Settings\jtitin\...\monImag e.jpg"

par

Dim m As Integer
'
'...
'
'
m = Sheets("Base").Range("F65536").End(xlUp).Row
monImage = Sheets("Base").Range("F" & m)

Bonne journée
MichelXld

 

[jtitin]

Re : nommer image pour enregistrement

bonjour forum
merci MichelXld pour ta réponse

mais je n'arrive pas à un bon fonctionnement
peut être, je ne place pas ton code ou il faut et le résultat est :
soit dans le dossier image, l'image est inexistante soit elle porte toujour le même nom (monimage.jpg)

je remet la macro avec ta partie de code dans ce message
si tu pouvait modifier ce qui ne va pas.

Merci


Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub collage_Image_V02()
Dim x As Byte
Dim Sh As Shape
Dim monImage As String
Dim m As Integer

m = Sheets("Base").Range("E65536").End(xlUp).Row
monImage = Sheets("Base").Range("E" & m)

x = ActiveSheet.Shapes.Count

Application.ScreenUpdating = False
ActiveSheet.Range("A1").Select
ActiveSheet.Paste

If x = ActiveSheet.Shapes.Count Then
Application.ScreenUpdating = True
MsgBox "Opération annulée"
Exit Sub

Else

Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
monImage = "C:\Documents and Settings\jtitin\Bureau\enregistre_imageJPG\monImage.jpg"

With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
.Paste
.Export monImage, "JPG"
End With

With ActiveSheet
.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
.Shapes(ActiveSheet.Shapes.Count).Delete
End With

Application.ScreenUpdating = True

End If

End Sub

 

[MichelXld]

Re : nommer image pour enregistrement

rebonjour

tu peux tester

Option Explicit
 
Sub collage_Image_V03()
    Dim x As Byte
    Dim Sh As Shape
    Dim monImage As String
    Dim m As Integer
 
    x = ActiveSheet.Shapes.Count
 
    Application.ScreenUpdating = False
    ActiveSheet.Range("A1").Select
    ActiveSheet.Paste
 
    'verifie si le collage effectué correspond à une image
    If x = ActiveSheet.Shapes.Count Then
        Application.ScreenUpdating = True
        MsgBox "Opération annulée"
        Exit Sub
 
        Else
 
        Set Sh = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
 
        m = Sheets("Base").Range("F65536").End(xlUp).Row
        monImage = "C:\" & Sheets("Base").Range("F" & m) & ".jpg"
 
        With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
            .Paste
            .Export monImage, "JPG"
        End With
 
        With ActiveSheet
            .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
            .Shapes(ActiveSheet.Shapes.Count).Delete
        End With
 
        Application.ScreenUpdating = True
    End If
End Sub

Bonne journée
MichelXld

 

[jtitin]

Re : nommer image pour enregistrement

re bonjour forum
bonjour MichelXld

Merci MichelXld c'est tout bon

Un grand Merci pour ton aide.