Добрый день, гуру экселя. Помогите разобраться в непростой проблеме.
На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.
Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg? (В ячейку - D25 вписан адрес вывода итогового файла 1.jpg ) Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.
Добрый день, гуру экселя. Помогите разобраться в непростой проблеме.
На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.
Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg? (В ячейку - D25 вписан адрес вывода итогового файла 1.jpg ) Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.Grell
Если плюнуть на Excel, то что должно получиться в результате объединения 3 картинок? У меня получается только что-то, вроде Пикассо, и иже с ним, т.е. мазня. А у вас? Возможно Малевич, черный квадрат?
Если плюнуть на Excel, то что должно получиться в результате объединения 3 картинок? У меня получается только что-то, вроде Пикассо, и иже с ним, т.е. мазня. А у вас? Возможно Малевич, черный квадрат?RAN
Сейчас - открываю каждую картинку в Пайнте, поочередно копирую эти картинки на лист как автофигуры. Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и вставляю в Пайнт. Затем в Пайнте жму на кнопку "Сохранить как".
То есть - сейчас процесс происходит без использования макросов.
Сейчас - открываю каждую картинку в Пайнте, поочередно копирую эти картинки на лист как автофигуры. Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и вставляю в Пайнт. Затем в Пайнте жму на кнопку "Сохранить как".
То есть - сейчас процесс происходит без использования макросов.Grell
... поочередно копирую эти картинки на лист как автофигуры. Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и ...
Просто в этом "алгоритме нигде не звучит слово "Excel". То же самое вы можете проделывать, "копируя как картинки на лист OpenOffice Writer и т.д.", например
С другой стороны, если вам именно так и нужно (вставить файлы в Excel как картинки, разместить шейпы на листе слева-направо, сгруппировать, сохранить сгруппированные шейпы как один jpeg-файл"... вот эту задачу уже можно решать.
... поочередно копирую эти картинки на лист как автофигуры. Потом группирую их на листе, потом копирую сгруппированное в буфер обмена и ...
Просто в этом "алгоритме нигде не звучит слово "Excel". То же самое вы можете проделывать, "копируя как картинки на лист OpenOffice Writer и т.д.", например
С другой стороны, если вам именно так и нужно (вставить файлы в Excel как картинки, разместить шейпы на листе слева-направо, сгруппировать, сохранить сгруппированные шейпы как один jpeg-файл"... вот эту задачу уже можно решать.AndreTM
Просто в этом "алгоритме нигде не звучит слово "Excel".
Слово "Эксель" - звучит в первом сообщении.
Напишу его еще раз.
На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.
Как МАКРОСОМ при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg? (В ячейку - D25 вписан адрес вывода итогового файла 1.jpg ) Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.
Просто в этом "алгоритме нигде не звучит слово "Excel".
Слово "Эксель" - звучит в первом сообщении.
Напишу его еще раз.
На листе в ячейках D4, H4, L4 - находятся адреса фотофайлов jpg - на диске.
Как МАКРОСОМ при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg? (В ячейку - D25 вписан адрес вывода итогового файла 1.jpg ) Порядок объединения - сначала 1.jpg, затем справа идет - 2.jpg. затем еще правее 3.jpg.Grell
Создаете пустой bitmap с размерами W=W1+W2+W3 H=max(H1,H2,H3) Читаете по пиксельно ,определяете координаты и цвет пикселя. Вставляете цвета пикселей в созданную болванку. Не забываете делать сдвиг координат при чтении других картинок. PS:Проще аплет в фотошопе написать.
Создаете пустой bitmap с размерами W=W1+W2+W3 H=max(H1,H2,H3) Читаете по пиксельно ,определяете координаты и цвет пикселя. Вставляете цвета пикселей в созданную болванку. Не забываете делать сдвиг координат при чтении других картинок. PS:Проще аплет в фотошопе написать.doober
попиксельно примерно так. Только здесь вывод на лист.
[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]
Цитата
а в макросе это как должно выглядеть
попиксельно примерно так. Только здесь вывод на лист.
[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
RAN, а какое отношение bmp файл имеет к моему вопросу?
Я уже несколько раз повторял вопрос: Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?
RAN, а какое отношение bmp файл имеет к моему вопросу?
Я уже несколько раз повторял вопрос: Как макросом при щелчке по кнопке - объединить файлы jpg, указанные по адресам в данных ячейках - в один файл jpg?Grell