export image "concatainée"

[maryse.lh]

Bonsoir à tous,

je vous expose brièvement le problème qui m'amène ici.
Je cherche à exporter une partie de mon fichier excel vers mon bureau sous forme d'image gif. Pour cela je sélectionne la zone à exporter, je clique sur copier et l'image est exportée.

1er problème, comment faire pour que l'image soit toujours exportée vers le bureau (actuellement ce n'est pas le cas) ?

2ème problème, je voudrais que sur l'image apparaisse également une zone fixe de mon tableau (la ligne A4 à M4 dans mon fichier test).
Cela est il possible ? je n'ai rien trouvé dans le forum qui puisse m'aider...

Autre question, est il possible de changer le nom de l'image en fonction de la sélection (par exemple "pantalon.gif" dans mon fichier test) ?

Merci d'avance pour vos lumières...
Et à tous bonnes fêtes de fin d'année !!

 

[PMO2]

Re : export image "concatainée"

Bonjour,

Essayez le code suivant à copier dans un module standard

Declare Function SHGetPathFromIDList& Lib "shell32.dll" ( _
  ByRef pidl As Long, ByVal pszPath As String)
Declare Function SHGetSpecialFolderLocation& Lib "shell32.dll" ( _
  ByVal hwnd As Long, ByVal csidl As Long, ByRef ppidl As ITEMIDLIST)
Const SUFFIXE As String = ".gif"
Const CSIDL_DESKTOP = &H0
Const CSIDL_PERSONAL = &H5
Type SHITEMID
  cb As Long
  abID As Byte
End Type
Type ITEMIDLIST
  mkid As SHITEMID
End Type

Sub ExportZoneTableau()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim R As Range
Dim NomImage$
Dim i&
Dim Chemin$
If TypeName(Selection) <> "Range" Then Exit Sub
Set R = Selection
If R.Rows.Count <> 7 Or R.Columns.Count <> 13 Then
  MsgBox "Veuillez sélectionner une plage de 7 lignes (colonnes A:M)"
  Exit Sub
End If
Application.ScreenUpdating = False
Set S1 = ActiveSheet
Set S2 = Sheets.Add
S1.Cells.Copy
S2.Cells.PasteSpecial Paste:=xlPasteFormats
S2.Range("1:3,5:6").Delete
R.Copy
S2.[a2].PasteSpecial Paste:=xlPasteAll
Set R = S1.Range("a4:m4")
R.Copy
S2.[a1].PasteSpecial Paste:=xlPasteAll
Set R = S2.[a1].CurrentRegion
R.CopyPicture
If S2.[b2] <> "" Then
  NomImage$ = S2.[b2]
Else
  NomImage$ = "imageExport"
End If
'--- Définir le BUREAU ou MES DOCUMENTS ---
'Chemin$ = PathSpecial(CSIDL_PERSONAL) & "\"  'Mes documents
Chemin$ = PathSpecial(CSIDL_DESKTOP) & "\"    'Bureau
'------------------------------------------
Do
  i& = i& + 1
Loop Until Dir(Chemin$ & NomImage$ & i& & SUFFIXE) = ""
S2.ChartObjects.Add(0, 0, R.Width, R.Height).Chart.Paste
S2.ChartObjects(1).Chart.Export Chemin$ & NomImage$ & i& & SUFFIXE
Application.DisplayAlerts = False
S2.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Function PathSpecial(SpecialFolder As Long) As String
Dim Retour&
Dim A$
Dim IDL As ITEMIDLIST
  Retour& = SHGetSpecialFolderLocation(0, SpecialFolder, IDL)
  If Retour& = 0 Then
    A$ = Space(512)
    Retour& = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal A$)
    PathSpecial = Left(A$, InStr(A$, vbNullChar) - 1)
  End If
End Function

Sélectionnez une plage de 7 lignes et de 13 colonnes et lancer la macro ExportZoneTableau
l'image sera sur le bureau.

Cordialement.

PMO
Patrick Morange

 

[maryse.lh]

Re : export image "concatainée"

Bonjour PMO2,

un grand merci, ça fonctionne parfaitement !
J'ai eu qq difficultés à adapter la macro à mon fichier car le code va bien au-delà de mes très maigres connaissances en VBA !
J'ai notamment du remplacer les "xlPasteAll" par des "xlPasteValuesAndNumberFormats" car mon tableau comporte plein de formules et de mfc.
Il n'y a maintenant que le changement de nom de l'image qui ne marche pas car contrairement à mon fichier test le champ dont dépend le nom est le résultat d'une formule, mais cela n'a pas beaucoup d'importance...
A vrai dire je ne m'attendais pas à un code aussi long et complexe !

Encore une fois merci et bonne année 2011 !