Программа iNETsHOP - обработка, сравнение, анализ прайс листов поставщиков, создание каталога товаров интернет магазина Форум - Программа iNETsHOP - Работа с программой - Экспорт прайса


http://inetshop.in.ua/index.php?p=showtopic&toid=287&fid=&area=1&print_post=1645
04.02.2016 19:10

support


Support


Количество сообщений   1199
Зарегистрирован:   11-04-2008, 19:11:57
Прайс-лист в Excel с фотографиями через VBScript
Вот пример создания прайс-листа в который потом производится экспорт фотографий товаров (не забудьте настроить доступ к базе данных):
Код

Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const xlContinuous = 1
Const xlDash = -4115
Const xlDashDot = 4
Const xlDashDotDot = 5
Const xlDot = -4118
Const xlDouble = -4119
Const xlLineStyleNone = -4142
Const xlSlantDashDot = 13

Const xlHairline = 1
Const xlMedium = -4138
Const xlThick = 4
Const xlThin = 2

Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11

Dim oConn, oRcordSet, oExcelApp, oWorkbook, oSheet, oShape

sPriceEmpty = "C:\TEMP\price1.xls"
sServerName = "127.0.0.1"
sDatabaseName = "iNETsHOP"
sUserName = "Admin"
sUserPwd = ""
iFotoRowHeight = 50
iFirstRow = 5
sFotoFileName = "C:\TEMP\temp_foto.jpg"

sColumnID = "A"
sColumnGoodName = "B"
sColumnBrandName = "C"
sColumnPrice = "D"
sColumnCategory = "F"
sColumnFoto = "E"


Set oConn = CreateObject("ADODB.Connection")
oConn.Open "Driver={SQL Server};Server=" & sServerName & ";Database=" & sDatabaseName & ";Uid=" & sUserName & ";Pwd=" & sUserPwd
'oConn.Open "Provider=SQLOLEDB;User ID=SA;Password=password;Initial Catalog="iNETsHOP";Data Source="127.0.0.1"
'MsgBox(oConn.Version)

Set oStream = CreateObject("ADODB.Stream")
Set oRcordSet = CreateObject("ADODB.Recordset")
oRcordSet.CursorType = 2
oRcordSet.LockType = 3
oRcordSet.Open "select G_ID, G_NAME, B_NAME, price, GR_FULL_NAME, G_IMAGE, DATALENGTH(G_IMAGE) as FotoLength from TBL_GROUPS inner join TBL_GOODS on G_GR_ID = GR_ID left outer join TBL_BRANDS on G_B_ID = B_ID", oConn

Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = False
oExcelApp.DisplayAlerts = False
oExcelApp.EnableEvents = False
oExcelApp.Visible = False
oExcelApp.AskToUpdateLinks = False

Set oWorkbook = oExcelApp.Workbooks.Open(sPriceEmpty)
'oWorkbook.CheckCompatibility = False

'Set oSheet = oWorkbook.Sheets("Лист1")
Set oSheet = oWorkbook.Sheets(1)

oSheet.Columns(sColumnID).ColumnWidth = 7
oSheet.Range(sColumnID & iFirstRow).Value = "Код"
oSheet.Range(sColumnID & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnID & iFirstRow).Font.Bold = True
oSheet.Range(sColumnID & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

oSheet.Columns(sColumnGoodName).ColumnWidth = 50
oSheet.Range(sColumnGoodName & iFirstRow).Value = "Название"
oSheet.Range(sColumnGoodName & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnGoodName & iFirstRow).Font.Bold = True
oSheet.Range(sColumnGoodName & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

oSheet.Columns(sColumnBrandName).ColumnWidth = 15
oSheet.Range(sColumnBrandName & iFirstRow).Value = "Бренд"
oSheet.Range(sColumnBrandName & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnBrandName & iFirstRow).Font.Bold = True
oSheet.Range(sColumnBrandName & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

oSheet.Columns(sColumnPrice).ColumnWidth = 10
oSheet.Range(sColumnPrice & iFirstRow).Value = "Цена"
oSheet.Range(sColumnPrice & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnPrice & iFirstRow).Font.Bold = True
oSheet.Range(sColumnPrice & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

oSheet.Columns(sColumnCategory).ColumnWidth = 60
oSheet.Range(sColumnCategory & iFirstRow).Value = "Категория"
oSheet.Range(sColumnCategory & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnCategory & iFirstRow).Font.Bold = True
oSheet.Range(sColumnCategory & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

oSheet.Columns(sColumnFoto).ColumnWidth = 15
oSheet.Range(sColumnFoto & iFirstRow).Value = "Фотография"
oSheet.Range(sColumnFoto & iFirstRow).Interior.Color = RGB(51, 204, 57)
oSheet.Range(sColumnFoto & iFirstRow).Font.Bold = True
oSheet.Range(sColumnFoto & iFirstRow).Borders(xlEdgeBottom).LineStyle = xlContinuous

i = iFirstRow + 1
Do While oRcordSet.EOF = 0
oSheet.Range(sColumnID & i).Value = oRcordSet.Fields("G_ID").Value
oSheet.Range(sColumnGoodName & i).Value = oRcordSet.Fields("G_NAME").Value
oSheet.Range(sColumnBrandName & i).Value = oRcordSet.Fields("B_NAME").Value
oSheet.Range(sColumnPrice & i).Value = oRcordSet.Fields("price").Value
oSheet.Range(sColumnPrice & i).Interior.Color = RGB(255, 255, 0)
oSheet.Range(sColumnCategory & i).Value = oRcordSet.Fields("GR_FULL_NAME").Value

If oRcordSet.Fields("FotoLength").Value > 0 then
oSheet.Rows(i).RowHeight = iFotoRowHeight

oStream.Type = adTypeBinary
oStream.Open
oStream.Write oRcordSet.Fields("G_IMAGE").Value
oStream.SaveToFile sFotoFileName, adSaveCreateOverWrite
oStream.Close

'oSheet.Range(sColumnFoto & i).Activate
'oSheet.Pictures.Insert(sFotoFileName)
'oSheet.Range("A1").Activate

iLeft = oSheet.Range(sColumnFoto & i).Left
iTop = oSheet.Range(sColumnFoto & i).Top
iWidth = oSheet.Range(sColumnFoto & i).Width
iHeight = oSheet.Range(sColumnFoto & i).Height
Set oShape = oSheet.Shapes.AddPicture(sFotoFileName, False, True, iLeft, iTop, -1, -1)
oShape.LockAspectRatio = True
oShape.Width = iWidth
oShape.Height = iHeight
End if

oRcordSet.MoveNext
i = i + 1
Loop

oExcelApp.Visible = True
'oWorkbook.Close True
'oExcelApp.Quit

'Set oSheet = Nothing
'Set oWorkbook = Nothing
'Set oExcelApp = Nothing

oConn.Close
Set oRcordSet = Nothing
Set oConn = Nothing
Set oStream = Nothing


По данному примеру можно дальше кастомизировать вид прайса - менять шрифты, цвет текста и фона, границы ячеек, высоту строк и ширину колонок и т.п. Вся использованная информация взята из документации по Excel, VBA, VBS. Так же по Excel и VBA существует большое количество специализированных форумов где можно найти примеры работы с листами, ячейками, регионами, фигурами и прочими элементами приложения Excel.

В прикрепленном архиве текст данного сценария.

Прикрепленные файлы
inetshop_price_export.vbs.zip   ( 20 Просмотров | 1.7 KB )