Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Объединение jpg - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение jpg (Макросы/Sub)
Объединение jpg
Grell Дата: Воскресенье, 11.06.2017, 17:38 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
Добрый день, гуру экселя.
Помогите разобраться в непростой проблеме.

На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.

Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
(В ячейку - D25 вписан адрес вывода итогового файла 1.jpg )
Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.
К сообщению приложен файл: 56460.xls (94.0 Kb) · 9510409.rar (68.5 Kb)
 
Ответить
СообщениеДобрый день, гуру экселя.
Помогите разобраться в непростой проблеме.

На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.

Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
(В ячейку - D25 вписан адрес вывода итогового файла 1.jpg )
Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.

Автор - Grell
Дата добавления - 11.06.2017 в 17:38
buchlotnik Дата: Воскресенье, 11.06.2017, 18:19 | Сообщение № 2
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Grell, вы действительно сейчас решаете эту задачу средствами Excel?
 
Ответить
СообщениеGrell, вы действительно сейчас решаете эту задачу средствами Excel?

Автор - buchlotnik
Дата добавления - 11.06.2017 в 18:19
KuklP Дата: Воскресенье, 11.06.2017, 19:24 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Мне тоже интересно :D


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеМне тоже интересно :D

Автор - KuklP
Дата добавления - 11.06.2017 в 19:24
Grell Дата: Воскресенье, 11.06.2017, 19:26 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
вы действительно сейчас решаете эту задачу средствами Excel?

Да, именно эксель.
 
Ответить
Сообщение
вы действительно сейчас решаете эту задачу средствами Excel?

Да, именно эксель.

Автор - Grell
Дата добавления - 11.06.2017 в 19:26
RAN Дата: Воскресенье, 11.06.2017, 19:55 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Если плюнуть на Excel, то что должно получиться в результате объединения 3 картинок?
У меня получается только что-то, вроде Пикассо, и иже с ним, т.е. мазня. А у вас? Возможно Малевич, черный квадрат?


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеЕсли плюнуть на Excel, то что должно получиться в результате объединения 3 картинок?
У меня получается только что-то, вроде Пикассо, и иже с ним, т.е. мазня. А у вас? Возможно Малевич, черный квадрат?

Автор - RAN
Дата добавления - 11.06.2017 в 19:55
Grell Дата: Воскресенье, 11.06.2017, 21:35 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
RAN, в результате объединения картинок - должен получится файл jpg - где картинки расставлены в ряд (слева направо)
К сообщению приложен файл: 5339810.jpg (20.1 Kb)
 
Ответить
СообщениеRAN, в результате объединения картинок - должен получится файл jpg - где картинки расставлены в ряд (слева направо)

Автор - Grell
Дата добавления - 11.06.2017 в 21:35
AndreTM Дата: Воскресенье, 11.06.2017, 21:52 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Ну так хотя бы покажите нам ваши попытки начать решать эту задачу "средствами VBA Excel". Что именно у вас не получается?

Только не забудьте указать, какую подключаемую библиотеку/надстройку вы использовали для работы с jpeg-графикой :)


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеНу так хотя бы покажите нам ваши попытки начать решать эту задачу "средствами VBA Excel". Что именно у вас не получается?

Только не забудьте указать, какую подключаемую библиотеку/надстройку вы использовали для работы с jpeg-графикой :)

Автор - AndreTM
Дата добавления - 11.06.2017 в 21:52
Grell Дата: Воскресенье, 11.06.2017, 23:21 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
Сейчас - открываю каждую картинку в Пайнте, поочередно копирую эти картинки на лист как автофигуры.
Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и вставляю в Пайнт.
Затем в Пайнте жму на кнопку "Сохранить как".

То есть - сейчас процесс происходит без использования макросов.
 
Ответить
СообщениеСейчас - открываю каждую картинку в Пайнте, поочередно копирую эти картинки на лист как автофигуры.
Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и вставляю в Пайнт.
Затем в Пайнте жму на кнопку "Сохранить как".

То есть - сейчас процесс происходит без использования макросов.

Автор - Grell
Дата добавления - 11.06.2017 в 23:21
buchlotnik Дата: Воскресенье, 11.06.2017, 23:30 | Сообщение № 9
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Grell, а вам не кажется, что в описанной схеме Excel - лишнее звено, почему вы просто в пейнте картинку не собираете?
 
Ответить
СообщениеGrell, а вам не кажется, что в описанной схеме Excel - лишнее звено, почему вы просто в пейнте картинку не собираете?

Автор - buchlotnik
Дата добавления - 11.06.2017 в 23:30
Grell Дата: Воскресенье, 11.06.2017, 23:40 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
buchlotnik, нет не кажется.
Иначе бы я не писал этот вопрос на форуме.
 
Ответить
Сообщениеbuchlotnik, нет не кажется.
Иначе бы я не писал этот вопрос на форуме.

Автор - Grell
Дата добавления - 11.06.2017 в 23:40
AndreTM Дата: Понедельник, 12.06.2017, 00:48 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Просто в вашем алго
... поочередно копирую эти картинки на лист как автофигуры.
Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и ...
Просто в этом "алгоритме нигде не звучит слово "Excel". То же самое вы можете проделывать, "копируя как картинки на лист OpenOffice Writer и т.д.", например :)

С другой стороны, если вам именно так и нужно (вставить файлы в Excel как картинки, разместить шейпы на листе слева-направо, сгруппировать, сохранить сгруппированные шейпы как один jpeg-файл"... вот эту задачу уже можно решать.


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеПросто в вашем алго
... поочередно копирую эти картинки на лист как автофигуры.
Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и ...
Просто в этом "алгоритме нигде не звучит слово "Excel". То же самое вы можете проделывать, "копируя как картинки на лист OpenOffice Writer и т.д.", например :)

С другой стороны, если вам именно так и нужно (вставить файлы в Excel как картинки, разместить шейпы на листе слева-направо, сгруппировать, сохранить сгруппированные шейпы как один jpeg-файл"... вот эту задачу уже можно решать.

Автор - AndreTM
Дата добавления - 12.06.2017 в 00:48
Grell Дата: Понедельник, 12.06.2017, 00:58 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
Просто в этом "алгоритме нигде не звучит слово "Excel".

Слово "Эксель" - звучит в первом сообщении.

Напишу его еще раз.

На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.

Как МАКРОСОМ при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
(В ячейку - D25 вписан адрес вывода итогового файла 1.jpg )
Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.
К сообщению приложен файл: 9151959.xls (94.0 Kb) · 2795862.rar (68.5 Kb)
 
Ответить
Сообщение
Просто в этом "алгоритме нигде не звучит слово "Excel".

Слово "Эксель" - звучит в первом сообщении.

Напишу его еще раз.

На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.

Как МАКРОСОМ при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
(В ячейку - D25 вписан адрес вывода итогового файла 1.jpg )
Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.

Автор - Grell
Дата добавления - 12.06.2017 в 00:58
doober Дата: Понедельник, 12.06.2017, 01:41 | Сообщение № 13
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Создаете пустой bitmap с размерами
W=W1+W2+W3
H=max(H1,H2,H3)
Читаете по пиксельно ,определяете координаты и цвет пикселя.
Вставляете цвета пикселей в созданную болванку.
Не забываете делать сдвиг координат при чтении других картинок.
PS:Проще аплет в фотошопе написать.


 
Ответить
СообщениеСоздаете пустой bitmap с размерами
W=W1+W2+W3
H=max(H1,H2,H3)
Читаете по пиксельно ,определяете координаты и цвет пикселя.
Вставляете цвета пикселей в созданную болванку.
Не забываете делать сдвиг координат при чтении других картинок.
PS:Проще аплет в фотошопе написать.

Автор - doober
Дата добавления - 12.06.2017 в 01:41
Grell Дата: Понедельник, 12.06.2017, 02:19 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
doober, а в макросе это как должно выглядеть?
 
Ответить
Сообщениеdoober, а в макросе это как должно выглядеть?

Автор - Grell
Дата добавления - 12.06.2017 в 02:19
alex77755 Дата: Понедельник, 12.06.2017, 15:42 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 362
Репутация: 64 ±
Замечаний: 0% ±

Цитата
Читаете по пиксельно

А BitBit нельзя разве прикрутить? быстрее же будет
Или StretchBlt


Могу помочь в VB6, VBA
Alex77755@mail.ru


Сообщение отредактировал alex77755 - Понедельник, 12.06.2017, 15:43
 
Ответить
Сообщение
Цитата
Читаете по пиксельно

А BitBit нельзя разве прикрутить? быстрее же будет
Или StretchBlt

Автор - alex77755
Дата добавления - 12.06.2017 в 15:42
doober Дата: Понедельник, 12.06.2017, 15:51 | Сообщение № 16
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Я саму идею подсказал.
Это и так понятно, что VBA не для этой задачи.


 
Ответить
СообщениеЯ саму идею подсказал.
Это и так понятно, что VBA не для этой задачи.

Автор - doober
Дата добавления - 12.06.2017 в 15:51
alex77755 Дата: Понедельник, 12.06.2017, 15:55 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 362
Репутация: 64 ±
Замечаний: 0% ±

Цитата
а в макросе это как должно выглядеть

попиксельно примерно так. Только здесь вывод на лист.

[vba]
Код


Private Type typHeader
    Tipo As String * 2
    Tamanho As Long
    res1 As Integer
    res2 As Integer
    Offset As Long
End Type

Private Type typInfoHeader
    Tamanho As Long
    Largura As Long
    Altura As Long
    Planes As Integer
    Bits As Integer
    Compression As Long
    ImageSize As Long
    xResolution As Long
    yResolution As Long
    nColors As Long
    ImportantColors As Long
End Type

Private Type typePixel
    b As Byte
    g As Byte
    r As Byte
End Type

Sub Desenho()

    Dim bmpHeader As typHeader
    Dim bmpInfoHeader As typInfoHeader
    Dim bmpPixel As typePixel
    
    Dim nCnt As Long
    Dim nRow As Integer, nCol As Integer
    Dim nRowBytes As Long
    
    Dim fBMP As String
    
    Worksheets(1).Activate
    Columns("A:IV").Delete
    Close
    fBMP = Workbooks(1).Path & "\" & "Sample.BMP"
   
    Open fBMP For Binary Access Read As 1 Len = 1
    Open Workbooks(1).Path & "\" & "test.txt" For Output As 2
    
        Get 1, 1, bmpHeader
        
        If bmpHeader.Tipo <> "BM" Then
            MsgBox "Not a bitmap file.", vbCritical, "Error"
            End
        End If
        
        Get 1, , bmpInfoHeader
        
        If bmpInfoHeader.Bits <> 24 Then
            MsgBox "Sorry, only 24-bits BMP files can be converted.", vbCritical, "Error"
            End
        End If
        If bmpInfoHeader.Compression <> 0 Then
            MsgBox "Sorry, only uncompressed BMP files can be converted.", vbCritical, "Error"
            End
        End If
        If bmpInfoHeader.Largura > 255 Or bmpInfoHeader.Altura > 1000 Then
            MsgBox "Image is " & bmpInfoHeader.Largura & " x " & _
                bmpInfoHeader.Altura & " pixels." & vbCrLf & _
                "Maximum size is 255 x 1000.", vbCritical, "Error"
            End
        End If
        
        Rows("1:" & bmpInfoHeader.Altura).RowHeight = 2
        nRowBytes = bmpInfoHeader.Largura * 3
        If nRowBytes Mod 4 <> 0 Then
            nRowBytes = nRowBytes + (4 - nRowBytes Mod 4)
        End If
        
        'Start actual conversion, reading each pixel...
        For nRow = 0 To bmpInfoHeader.Altura - 1
            'Rows(nRow).RowHeight = 2
            For nCol = 0 To bmpInfoHeader.Largura - 1
                If nRow = 0 Then
                    Columns(nCol + 1).ColumnWidth = 0.17
                End If
                Get 1, bmpHeader.Offset + 1 + nRow * nRowBytes + nCol * 3, bmpPixel
                'Get 1, , bmpPixel
'                Cells(bmpInfoHeader.Altura - nRow, nCol + 1).Interior.Color = RGB(bmpPixel.r, bmpPixel.g, bmpPixel.b)
'                Debug.Print bmpPixel.r, bmpPixel.g, bmpPixel.b
              '  If bmpPixel.r > 240 Then
              ' If bmpPixel.g >= 120 And bmpPixel.g <= 220 Then
              '  If bmpPixel.b >= 120 And bmpPixel.b <= 220 Then
                Print #2, nRow, nCol
                Cells(bmpInfoHeader.Altura - nRow, nCol + 1).Interior.Color = RGB(bmpPixel.r, bmpPixel.g, bmpPixel.b)
             '   End If
             '  End If
             '   End If
            Next
        Next
    Close
    
    Cells(1, 1).Select
    
    MsgBox "Image generated", , "Ready"

End Sub
[/vba]


Могу помочь в VB6, VBA
Alex77755@mail.ru


Сообщение отредактировал alex77755 - Понедельник, 12.06.2017, 15:56
 
Ответить
Сообщение
Цитата
а в макросе это как должно выглядеть

попиксельно примерно так. Только здесь вывод на лист.

[vba]
Код


Private Type typHeader
    Tipo As String * 2
    Tamanho As Long
    res1 As Integer
    res2 As Integer
    Offset As Long
End Type

Private Type typInfoHeader
    Tamanho As Long
    Largura As Long
    Altura As Long
    Planes As Integer
    Bits As Integer
    Compression As Long
    ImageSize As Long
    xResolution As Long
    yResolution As Long
    nColors As Long
    ImportantColors As Long
End Type

Private Type typePixel
    b As Byte
    g As Byte
    r As Byte
End Type

Sub Desenho()

    Dim bmpHeader As typHeader
    Dim bmpInfoHeader As typInfoHeader
    Dim bmpPixel As typePixel
    
    Dim nCnt As Long
    Dim nRow As Integer, nCol As Integer
    Dim nRowBytes As Long
    
    Dim fBMP As String
    
    Worksheets(1).Activate
    Columns("A:IV").Delete
    Close
    fBMP = Workbooks(1).Path & "\" & "Sample.BMP"
   
    Open fBMP For Binary Access Read As 1 Len = 1
    Open Workbooks(1).Path & "\" & "test.txt" For Output As 2
    
        Get 1, 1, bmpHeader
        
        If bmpHeader.Tipo <> "BM" Then
            MsgBox "Not a bitmap file.", vbCritical, "Error"
            End
        End If
        
        Get 1, , bmpInfoHeader
        
        If bmpInfoHeader.Bits <> 24 Then
            MsgBox "Sorry, only 24-bits BMP files can be converted.", vbCritical, "Error"
            End
        End If
        If bmpInfoHeader.Compression <> 0 Then
            MsgBox "Sorry, only uncompressed BMP files can be converted.", vbCritical, "Error"
            End
        End If
        If bmpInfoHeader.Largura > 255 Or bmpInfoHeader.Altura > 1000 Then
            MsgBox "Image is " & bmpInfoHeader.Largura & " x " & _
                bmpInfoHeader.Altura & " pixels." & vbCrLf & _
                "Maximum size is 255 x 1000.", vbCritical, "Error"
            End
        End If
        
        Rows("1:" & bmpInfoHeader.Altura).RowHeight = 2
        nRowBytes = bmpInfoHeader.Largura * 3
        If nRowBytes Mod 4 <> 0 Then
            nRowBytes = nRowBytes + (4 - nRowBytes Mod 4)
        End If
        
        'Start actual conversion, reading each pixel...
        For nRow = 0 To bmpInfoHeader.Altura - 1
            'Rows(nRow).RowHeight = 2
            For nCol = 0 To bmpInfoHeader.Largura - 1
                If nRow = 0 Then
                    Columns(nCol + 1).ColumnWidth = 0.17
                End If
                Get 1, bmpHeader.Offset + 1 + nRow * nRowBytes + nCol * 3, bmpPixel
                'Get 1, , bmpPixel
'                Cells(bmpInfoHeader.Altura - nRow, nCol + 1).Interior.Color = RGB(bmpPixel.r, bmpPixel.g, bmpPixel.b)
'                Debug.Print bmpPixel.r, bmpPixel.g, bmpPixel.b
              '  If bmpPixel.r > 240 Then
              ' If bmpPixel.g >= 120 And bmpPixel.g <= 220 Then
              '  If bmpPixel.b >= 120 And bmpPixel.b <= 220 Then
                Print #2, nRow, nCol
                Cells(bmpInfoHeader.Altura - nRow, nCol + 1).Interior.Color = RGB(bmpPixel.r, bmpPixel.g, bmpPixel.b)
             '   End If
             '  End If
             '   End If
            Next
        Next
    Close
    
    Cells(1, 1).Select
    
    MsgBox "Image generated", , "Ready"

End Sub
[/vba]

Автор - alex77755
Дата добавления - 12.06.2017 в 15:55
Grell Дата: Понедельник, 12.06.2017, 16:45 | Сообщение № 18
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
alex77755, не работает.
Запустил макрос - тот написал "Not a bitmap file".
 
Ответить
Сообщениеalex77755, не работает.
Запустил макрос - тот написал "Not a bitmap file".

Автор - Grell
Дата добавления - 12.06.2017 в 16:45
RAN Дата: Понедельник, 12.06.2017, 16:48 | Сообщение № 19
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010

"Not a bitmap file"

На 1.bmp ругаться не будет.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
"Not a bitmap file"

На 1.bmp ругаться не будет.

Автор - RAN
Дата добавления - 12.06.2017 в 16:48
Grell Дата: Понедельник, 12.06.2017, 16:59 | Сообщение № 20
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
На 1.bmp ругаться не будет.


RAN, а какое отношение bmp файл имеет к моему вопросу?

Я уже несколько раз повторял вопрос:
Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
 
Ответить
Сообщение
На 1.bmp ругаться не будет.


RAN, а какое отношение bmp файл имеет к моему вопросу?

Я уже несколько раз повторял вопрос:
Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?

Автор - Grell
Дата добавления - 12.06.2017 в 16:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Объединение jpg (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!