Изображение в файл

Программирование на Visual Basic for Applications
Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Изображение в файл

Сообщение Владимир7 » 27.10.2010 (Ср) 10:02

На листе Excel ячейки имеют фоновый цвет.
Зная цвет каждой из ячеек на листе каким образом с помощью VBA можно создать файл типа jpg png bmp c изображением соответсвующем изображению на листе Excel, пиксель нового файла должен быть такого же цвета как цвет фона отдельной ячейки листа Excel ?
Вложения
Foto.zip
(964.67 Кб) Скачиваний: 77

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 28.10.2010 (Чт) 13:28

Следующий код НЕ работает. Но должен! Посмотрите, где ошибка? Так вместе и поможем автору.
(добавляем в VBA-проект excel новую форму и копируем в нее нижеследующее)
Код: Выделить всё
Option Explicit

Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub UserForm_Click()
   
    Dim x As Long
    Dim y As Long
       
    x = 10
    y = 10
   
    Dim picBuffer As Image
    Set picBuffer = New Image
   
    picBuffer.Picture = LoadPicture("C:\Temp\xlsimg.bmp", x, y)
               
    For x = 1 To 10
    For y = 1 To 10
        Range("A1").Select
        ActiveCell.Offset(x, y).Range("A1").Select
        SetPixel GetDC(picBuffer.Picture.Handle), x, y, _
        ActiveCell.Interior.Color
       
        Range("A1").Select
    Next
    Next
   
    SavePicture picBuffer.Picture, "C:\Temp\xlsimg.bmp"
   
   
End Sub
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 28.10.2010 (Чт) 17:53

Ваш код рабочий.
Даже в таком варианте: (только сохраняет первоначально открытое изображение)
Код: Выделить всё
Sub UserForm_Click()
    'Dim x As Long
    'Dim y As Long
    'x = 10
    'y = 10
    Dim picBuffer As Image
    Set picBuffer = New Image
    picBuffer.Picture = LoadPicture("D:\img.bmp", x, y)
    'For x = 1 To 10
    'For y = 1 To 10
    '    Range("A1").Select
    '    ActiveCell.Offset(x, y).Range("A1").Select
    '    SetPixel GetDC(picBuffer.Picture.Handle), x, y, ActiveCell.Interior.Color
    'Next
    'Next
    SavePicture picBuffer.Picture, "D:\xlsimg.bmp"
End Sub

[Viper] :: Не забываем пользоваться тэгами CODE!

Andrev
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 108
Зарегистрирован: 19.01.2005 (Ср) 9:22
Откуда: Kursk

Re: Изображение в файл

Сообщение Andrev » 28.10.2010 (Чт) 22:04

Денис писал(а):Следующий код НЕ работает. Но должен!
Код: Выделить всё
Может быть из-за того, что
[code]
picBuffer.Picture = LoadPicture("C:\Temp\xlsimg.bmp", x, y)
SavePicture picBuffer.Picture, "C:\Temp\xlsimg.bmp"
[/code] ?
   
   
End Sub
В этой жизни нет ничего невозможного. Если у вас что-то не получается, значит, вы что-то делаете не так.

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 29.10.2010 (Пт) 8:15

Andrev писал(а):
Денис писал(а):Следующий код НЕ работает. Но должен!

Может быть из-за того, что
Код: Выделить всё
picBuffer.Picture = LoadPicture("C:\Temp\xlsimg.bmp", x, y)
SavePicture picBuffer.Picture, "C:\Temp\xlsimg.bmp"
?


End Sub[/code]


Эмм, не понял, что ты хочешь сказать? Я делаю инициализацию IPictureDisp временным изображением из файла, а затем в этот же файл записываю полученное изображение. Это минус, да.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 02.11.2010 (Вт) 13:56

Цель не открыть файл-картинку и сохранить её же на диск, может даже и с новым именем.
Если взять, например, редактор иконок, то закрасив несколько квадратиков в таком редакторе, получаем новый файл изображения, в котором закраска пикселей такая же как и при редактировании иконки.
Работа в подобном графическом редакторе и даёт мысль о возможном использовании Excel для создания с нуля или редактировании имеющихся файлов изображений. В графическом редакторе cоздание/редактирование изображения одновариантно вручную, и как раз обратное можно сказать о возможностях Excel.
Вложения
U.rar
(3.71 Кб) Скачиваний: 69

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 02.11.2010 (Вт) 14:11

Владимир7 писал(а):Работа в подобном графическом редакторе и даёт мысль о возможном использовании Excel для создания с нуля или редактировании имеющихся файлов изображений.

Бедные нубы, до чего только не додумаются. Ничего, сам таким был.
Забей на Excel, Владимир, давай лучше мы научим тебя загружать изображение в Picturebox, квадратиками, с сеточкой, всё как в редакторах иконок. Хочешь?
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 02.11.2010 (Вт) 14:28

Нубы - первый раз слышу - надо в сети поиском найти - любопытно!
В Picturebox, квадратиками - не хочу, интересует то о чём пишу (не упрямый ребенок, а целеустремлённная личность :lol: )
Сам таким был - сейчас то можешь подсказать направление решения именно Excel VBA ?
Пусть не полное решение, ну хоть бы направление верное...

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 02.11.2010 (Вт) 14:34

Владимир7 писал(а):сейчас то можешь подсказать направление решения именно Excel VBA

Уже подсказал. В своем первом сообщении.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 02.11.2010 (Вт) 14:35

Нуб - весьма верное определение, дайте же подсказочку по теме ...

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 02.11.2010 (Вт) 14:44

Денис, не пойму в чём подсказка, примерно так как Вы говорите, я делал свой первый файл, тот что в первом посте с фоновой картинкой Excel. Это как бы этап пройденный. Пожалуйста вернитесь непосредственно к теме вопроса, может Вы встречали в сети что либо подобное, хотелось бы всё таки решить проблему.

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 03.11.2010 (Ср) 10:14

Владимир7 писал(а):Денис, не пойму в чём подсказка

Давайте сначала говорить на одном языке, а не на разных. Для того,чтобы это сделать, сформируйте алгоритм решения вашей задачи по шагам. Затем мы вместе начнем разбирать шаги по отдельности. Вот пример алгоритма:
    • Проснулся.
    • Открыл глаза.
    • Откинул одеяло.
    • Опустил на пол ноги.
    • Обул правую ногу в правый тапок.
    • Обул левую ногу в левый тапок.
Надеюсь смысл ясен.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 03.11.2010 (Ср) 10:38

Алгоритм предельно прост:
1. Открываем новый лист Excel;
2. В ячейках А1, А2 задаём фон зеленого цвета;
3. В ячейках В1, В2 задаём фон синего цвета;
4. Сохраняем на диске файл;
5. Оставляем Excel в покое, начинаем изучать форматы файлов изображений и порядок их создания;
6. И вот когда Educated Full можно вернуться к своему файлу Excel и используя VBA создать интересующий нас новый файл изображения в котором левый верхний пиксель будет зеленого цвета и т.д.

Пока я застрял по этому алгоритму на первой половине 5 пункта :)

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 03.11.2010 (Ср) 13:41

Владимир7 писал(а):начинаем изучать форматы файлов изображений и порядок их создания

5.1. Чтобы не забивать себе голову форматами файлов на данном этапе, рекомендую использовать
5.2. функции GetPixel() SetPixel().
Есть в моем коде, который я привел сразу же. Первая получает значение цвета пиксела по указанным координатам картинки, измеряя ее в пикселах, вторая записывает в картинку значение цвета пиксела по указанным координатам. Картинка, это объект. У меня в примере он называется picBuffer. При создании объекта, он пустой. Как правильно проинициализировать его я не знаю (и сдается мне это и не возможно) кроме как загрузить в него любой BMP-файл с диска. Что я и делаю в примере.
Проблема в том, что цвета из ячеек не хотят записываться в объект-картинку, о чем я и написал сразу же, что приведенный код не работает.
Ждем, пока кто-нибудь нам еще поможет советом.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 03.11.2010 (Ср) 14:06

Нашёл для начала:
http://jenyay.net/Programming/Bmp
но это уж наверно такой длинный путь...
GetPixel() для получения цвета пикселей из исходной картинки с диска и закраски фонового цвета ячеек листа - да,
SetPixel() надо пробовать.

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 03.11.2010 (Ср) 16:13

Любопытная ссылка, сейчас гляну, а пока, с нуля склепал такой код:
Код: Выделить всё
Option Explicit

Private Sub UserForm_Click()
   
    Dim X As Integer
    Dim Y As Integer
    Dim b As Byte
    Dim s As String
    Dim s0 As String
    Dim BMP_HEADER As String
   
    X = 10
    Y = 10
   
    BMP_HEADER = "BM:" & _
                String(7, Chr$(0)) & _
                "6" & _
                String(3, Chr$(0)) & _
                "(" & _
                String(3, Chr$(0)) & _
                Chr$(X) & _
                String(3, Chr$(0)) & _
                Chr$(Y) & _
                String(3, Chr$(0)) & _
                Chr$(1) & Chr$(0) & Chr$(&H18) & _
                String(5, Chr$(0)) & _
                Chr$(4) & _
                String(19, Chr$(0))
   
    Open "C:\Temp\xlsimg.bmp" For Binary As #1
        For X = 1 To Len(BMP_HEADER)
            s = Mid$(BMP_HEADER, X, 1)
            Put #1, , s
        Next

    For Y = 0 To 9
        For X = 0 To 9
            Range("A1").Select
            ActiveCell.Offset(X, Y).Range("A1").Select
            Put #1, , ActiveCell.Interior.Color
            Range("A1").Select
        Next
    Next
   
    Close #1
       
End Sub

Файл сохраняется, но цвета передаются неправильно. После праздников потыкаю еще.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 03.11.2010 (Ср) 21:39

Подвижка есть,
цвета пока ещё не те, разные вариации записи в новый файл, в.т.ч. RGB не выдают решение
Код: Выделить всё
Private Sub UserForm_Click()
    Dim x As Integer, Y As Integer, b As Byte, s As String, s0 As String, BMP_HEADER As String, str0 As String, str As String
    x = 10: Y = 10
    BMP_HEADER = "BM:" & String(7, Chr$(0)) & "6" & String(3, Chr$(0)) & "(" & String(3, Chr$(0)) & Chr$(x) & String(3, Chr$(0)) & Chr$(Y) & String(3, Chr$(0)) & Chr$(1) & Chr$(0) & Chr$(&H18) & String(5, Chr$(0)) & Chr$(4) & String(19, Chr$(0))
    Open "D:\Downloads\LR.bmp" For Binary As #1
    For cX = 1 To Len(BMP_HEADER)
        s = Mid$(BMP_HEADER, cX, 1)
        Put #1, , s
    Next
    For bY = 0 To 9
        For aX = 0 To 9
            str0 = Right("000000" & Hex(Cells(aX + 1, bY + 1).Interior.Color), 6)
            str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
            re = ConvertDec(Right(str0, 2)): gr = ConvertDec(Mid(str0, 3, 2)): bl = ConvertDec(Left(str0, 2))
            cv = re & gr & bl 'cv = re & "." & gr & "." & bl 'cv = 254000000'cv = 254254254'cv = "&H254"
            Put #1, , cv
        Next
    Next
    Close #1
    Me.Hide
End Sub
Function ConvertDec(heximal) As Long
    Dim Simvol As String, DesChislo As Long, x As Long
    ConvertDec = 0
    For x = 1 To Len(heximal)
        Simvol = Mid(heximal, x, 1)
        If UCase(Simvol) = "A" Then
            DesChislo = 10
        ElseIf UCase(Simvol) = "B" Then
            DesChislo = 11
        ElseIf UCase(Simvol) = "C" Then
            DesChislo = 12
        ElseIf UCase(Simvol) = "D" Then
            DesChislo = 13
        ElseIf UCase(Simvol) = "E" Then
            DesChislo = 14
        ElseIf UCase(Simvol) = "F" Then
            DesChislo = 15
        Else
            DesChislo = Val(Simvol)
        End If
        ConvertDec = ConvertDec + DesChislo * 16 ^ (Len(heximal) - x)
    Next x
End Function

Viper
Артефакт VBStreets
Артефакт VBStreets
Аватара пользователя
 
Сообщения: 4389
Зарегистрирован: 12.04.2005 (Вт) 17:50
Откуда: Н.Новгород

Re: Изображение в файл

Сообщение Viper » 04.11.2010 (Чт) 13:28

Работа со строками при записи/чтении изображения это мягко говоря неправильно. То есть совсем.
Весь мир матрица, а мы в нем потоки байтов!

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 04.11.2010 (Чт) 19:47

Та да, неправильно.
Приятно что проявили интерес такие уважаемые люди!

Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 06.11.2010 (Сб) 11:28

Viper писал(а):Работа со строками при записи/чтении изображения это мягко говоря неправильно. То есть совсем.

Надеюсь, это не мне было адресовано? Потому что в моем примере я работал с байтами (несмотря на то, что заголовки я получил обратной разработкой из шестнадцатеричного дампа bmp-файла и объявил их как строку, я все равно работаю с ней (строкой) как с массивом байтов.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Владимир7
Обычный пользователь
Обычный пользователь
 
Сообщения: 59
Зарегистрирован: 13.03.2008 (Чт) 22:12

Re: Изображение в файл

Сообщение Владимир7 » 06.11.2010 (Сб) 12:14


Денис
Доктор VB наук
Доктор VB наук
Аватара пользователя
 
Сообщения: 2734
Зарегистрирован: 07.11.2006 (Вт) 13:55
Откуда: Ейск, Краснодарский край

Re: Изображение в файл

Сообщение Денис » 06.11.2010 (Сб) 14:16


Это делалось либо на API либо в .Net, даже и не мечтай сделать это встроенными средствами VBA.
Программирование — богоизбранная дисциплина! Если бог и есть, то вселенную он скомпилировал, не иначе.

Viper
Артефакт VBStreets
Артефакт VBStreets
Аватара пользователя
 
Сообщения: 4389
Зарегистрирован: 12.04.2005 (Вт) 17:50
Откуда: Н.Новгород

Re: Изображение в файл

Сообщение Viper » 06.11.2010 (Сб) 15:00

Денис писал(а):
Viper писал(а):Работа со строками при записи/чтении изображения это мягко говоря неправильно. То есть совсем.

Надеюсь, это не мне было адресовано? Потому что в моем примере я работал с байтами (несмотря на то, что заголовки я получил обратной разработкой из шестнадцатеричного дампа bmp-файла и объявил их как строку, я все равно работаю с ней (строкой) как с массивом байтов.
Адресовано было несомненно Владимир7.
Весь мир матрица, а мы в нем потоки байтов!


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: Bing-бот и гости: 6

    TopList  
cron