Можно и с машиной))) Только мне нечего показывать Может я не очень корректно задаю вопрос, но у меня есть вариант вставки QR кода в активную ячейку, а мне надо сохранить в файл. По ссылкам на самом деле первая ближе.
Можно и с машиной))) Только мне нечего показывать Может я не очень корректно задаю вопрос, но у меня есть вариант вставки QR кода в активную ячейку, а мне надо сохранить в файл. По ссылкам на самом деле первая ближе.Ilya40
Вообще не вдаваясь в подробности, просто тупо вставка одного кода вовнутрь другого (ну и выделение картинки дописал) [vba]
Код
Sub tt() Text = Cells(1, 1) ActiveSheet.Pictures.Insert ("https://chart.googleapis.com/chart?cht=qr&chs=150x150&chl=" & Text) ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Select Dim sName As String, oObj As Object, wsTmpSh As Worksheet If VarType(Selection) <> vbObject Then MsgBox "Выделенная область не является объектом!", vbCritical, "Ха-ха!!!" Exit Sub End If Application.ScreenUpdating = False Application.DisplayAlerts = False Set oObj = Selection: oObj.Copy Set wsTmpSh = ThisWorkbook.Sheets.Add sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_" & oObj.Name With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart .ChartArea.Border.LineStyle = 0 .Parent.Select .Paste .Export Filename:=sName & ".gif", FilterName:="GIF" .Parent.Delete End With wsTmpSh.Delete Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
[/vba]
Вообще не вдаваясь в подробности, просто тупо вставка одного кода вовнутрь другого (ну и выделение картинки дописал) [vba]
Код
Sub tt() Text = Cells(1, 1) ActiveSheet.Pictures.Insert ("https://chart.googleapis.com/chart?cht=qr&chs=150x150&chl=" & Text) ActiveSheet.Pictures(ActiveSheet.Pictures.Count).Select Dim sName As String, oObj As Object, wsTmpSh As Worksheet If VarType(Selection) <> vbObject Then MsgBox "Выделенная область не является объектом!", vbCritical, "Ха-ха!!!" Exit Sub End If Application.ScreenUpdating = False Application.DisplayAlerts = False Set oObj = Selection: oObj.Copy Set wsTmpSh = ThisWorkbook.Sheets.Add sName = ActiveWorkbook.FullName & "_" & ActiveSheet.Name & "_" & oObj.Name With wsTmpSh.ChartObjects.Add(0, 0, oObj.Width, oObj.Height).Chart .ChartArea.Border.LineStyle = 0 .Parent.Select .Paste .Export Filename:=sName & ".gif", FilterName:="GIF" .Parent.Delete End With wsTmpSh.Delete Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub