Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Программирование, связанное с MS Office > Сохранение каринки


Автор: Izuver 9.10.2010, 17:33
Как сохранить каринку если знаешь ее эл.адресс или она находится на листе xl?

Автор: mihanik 11.10.2010, 22:31
Izuver, включи макрорекордер, выполни последовательность действий, посмотри, что получилось в макросах...

Автор: Bugmaker 12.10.2010, 13:37
mihanik в меню по нажатии пкм в excel на картинке, нету пункта "Сохранить изображение". Как быть? )

Автор: Izuver 13.10.2010, 14:53
Уместный вопрос, жаль его я сам не задал

Автор: mihanik 15.10.2010, 10:56
Копируешь картинку в буфер обмена а потом изучаешь

http://forum.vingrad.ru/index.php?showtopic=118548&view=findpost&p=902983

Автор: Izuver 15.10.2010, 20:36
Код

SavePicture Pict, "I:\Б\DDD.jpg"

замечательно, но как мне задать переменную в виде эл.аресса или выделенной картинки, без копирования в буффер?

Автор: mihanik 15.10.2010, 21:11
Не знаю...

 smile 

Думать нужно...
Попробуй сначала способ с буфером.

Автор: Izuver 16.10.2010, 06:21
ошибка возникает в строке
Код

Set Pict = Clipboard.GetData

или

Set Pict = Clipboard.GetData(vbCFBitmap)

http://clip2net.com/clip/m49433/1287200172-clip-14kb.png

Автор: mihanik 16.10.2010, 12:51
Izuver, а ты как Pict объявил?

Автор: Izuver 16.10.2010, 13:51
Dim Pict As IPictureDisp
там в ссылке на картинку показано

Добавлено через 6 минут и 49 секунд
Если эта картинка находится в объекте Image1 на форме, то код этот работает:
Код

Private Sub CommandButton1_Click()
SavePicture Image1.Picture, "I:\Б\DDD.jpg"
End Sub

так же и через лист, а вот как ее загрузить туда? Через LoadPicture перепробовал уже все что мог

Автор: alex77755 17.10.2010, 22:21
На паралельном сайте аналогичный вопрос.
С листа Ексел картинку в файл:
Код


Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
 Const CF_ENHMETAFILE As Long = 14
 Sub GetPictures()
 Dim PShape As Shape, hStrPtr As Long
 For Each PShape In ActiveSheet.Shapes
 If PShape.Type = msoPicture Then
    PShape.CopyPicture
    If Not CBool(OpenClipboard(0)) Then
      MsgBox "Не удалось открыть буфер"
      GoTo NextSh
    End If
    hStrPtr = GetClipboardData(CF_ENHMETAFILE)   
    If Not CBool(hStrPtr) Then
      MsgBox "Не удалось получить дескриптор"
      GoTo CloseClip
    End If
    If Not CBool(CopyEnhMetaFile(hStrPtr, "c:" & "\" & "Temp" & "\" & "pic" & hStrPtr & ".jpg")) Then
      MsgBox "Не удалось создать файл"
      GoTo CloseClip
    End If    
CloseClip: 
    CloseClipboard 
NextSh: 
 End If 
Next 
End Sub

Автор: Izuver 18.10.2010, 19:00
Сколько всего не понятного для меня, зато работает, но думаю так проще:
Код

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Const CF_ENHMETAFILE As Long = 14
Sub fasdf()
ActiveSheet.Pictures.Insert("http://forum.vingrad.ru/uploads/av-23980.jpg").CopyPicture
If Not CBool(OpenClipboard(0)) Then
End If
If Not CBool(CopyEnhMetaFile(GetClipboardData(CF_ENHMETAFILE), "I:\Б\DD1.jpg")) Then
End If
CloseClipboard
End Sub

что такое CBool, и зачем его использовать в условии

Автор: mihanik 18.10.2010, 22:11
CBool (выражение)

Переводит "выражение" в булевский вид; true, false

Добавлено через 1 минуту и 29 секунд
Тогда уж так

Код

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Const CF_ENHMETAFILE As Long = 14
Sub fasdf()
ActiveSheet.Pictures.Insert("http://forum.vingrad.ru/uploads/av-23980.jpg").CopyPicture
CloseClipboard
End Sub


Это если ты сбойные ситуации отлавливать не хочешь.

Автор: Izuver 20.10.2010, 16:09
что это? зачем убрал те условия, у меня ведь проблема с сохранением картинки была
в прошлых ссылках она решалась с помощью SavePicture, но энто только для элементов формы

Автор: mihanik 20.10.2010, 21:20
Ну... Вопрос спорный...
Будешь смеятся!

1. Условия я убрал опрометчиво.
2. Именно "условия" там не нужны.

Вот такой вот парадокс.  smile 

Автор: Izuver 23.10.2010, 18:53
А как тогда без них сохранить картинку по определенному адресу?

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)