powered by simpleCommunicator - 2.0.38     © 2025 Programmizd 02
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
13 сообщений из 13, страница 1 из 1
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849828
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
проблема с формирование QR кода компонентой MSBCODE964.OCX

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Sub setQR()
'Updated by Extendoffice 2018/8/22
    Dim xSRg As Range
    Dim xRRg As Range
    Dim xObjOLE As OLEObject
    On Error Resume Next
  
    ActiveSheet.Shapes.Range(Array("BarCodeCtrl2")).Select
    Selection.Delete
    
    'Set xSRg = Application.InputBox("Please select the cell you will create QR code based on", "Kutools for Excel", , , , , , 8)
    Set xSRg = Range("$B2")
    If xSRg Is Nothing Then Exit Sub
    'Set xRRg = Application.InputBox("Select a cell to place the QR code", "Kutools for Excel", , , , , , 8)
    Set xRRg = Range("C15")
    If xRRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    Application.CutCopyMode = True
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = xSRg.Text
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste Range("G3")
    xObjOLE.Delete
    Application.ScreenUpdating = True
   
End Sub



Вот такой вариант, по кнопке, взятый с интернета работает.
Если перенести код в функцию и вызывать по изменению ячейки, то не работает. подскажите в чём проблема?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Function QRCode(ByVal QR_Value As String)

 'Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
 'xObjOLE.Object.Style = 11
 'xObjOLE.Object.Value = "aaaaaaafffffffff"
 'ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
 'ActiveSheet.Paste Range("G3")

 QRCode = "Name"
 
End Function



Модератор: Учимся использовать тэги оформления кода - FAQ

Без комментариев не работает, просто завершается не доходя до "QRCode = "Name""
Комментим, и функция отрабатывает.
В чём подвох? Почему оно по кнопке отрабатывает, а по функции нет.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849838
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
TorLinkфункцию и вызывать по изменению ячейкиЧто будет, если в функции по изменению ячейки делать изменения ячеек? Естественно рекурсивный бесконечный цикл и переполнение стека
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849885
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.ProTorLinkфункцию и вызывать по изменению ячейкиЧто будет, если в функции по изменению ячейки делать изменения ячеек? Естественно рекурсивный бесконечный цикл и переполнение стека
Ячейки то разные. В одной меняется значение, в другой в функция на основе первой, которая меняет третью ячейку.
Во вложении файлик на основе которого я пытаюсь сделать. Только там гугл, а мне нужен оффлайн инструмент. Но формирование кода по изменению ячейки там прекрасно работает.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849917
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Какой из кучи файлов - с вашими попытками?
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849931
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, ой, прошу прощения, не тот приложил. Там просто раскопирован файл, чтобы быть больше 100кб)
QR.7z - это то, что взято за основу. Работает, за исключением того, что там гугл.(
Вот мне надо, чтобы работало так же по формуле. Но, через компоненту, как в первом блоке кода первого поста.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849938
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
TorLinkQR.7z - это то, что взято за основуЕще раз - где тот код, который не работает?
Вместе с файлом.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39849986
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, чёт не врубаюсь, не прикрепились опять файлы?(
https://yadi.sk/d/IXrQ6jX_zeViyQ вот выложил. 3 файла.
файл Test. Не работает.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Function QRCode(ByVal QR_Value As String)

 Dim xSRg As Range
 Dim xRRg As Range
 Dim xObjOLE As OLEObject
 
 Set xRRg = Range("C15")
    
Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
 xObjOLE.Object.Style = 11
 xObjOLE.Object.Value = QR_Value
  ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
 ActiveSheet.Paste xRRg

 QRCode = "Name"
 
End Function



Файл QR_Test. Работает по формуле через гугл.апи.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
Function URL_QRCode_SERIES( _
    ByVal PictureName As String, _
    ByVal QR_Value As String, _
    Optional ByVal PictureSize As Long = 120, _
    Optional ByVal DisplayText As String = "", _
    Optional ByVal Updateable As Boolean = True) As Variant

Dim oPic As Shape, oRng As Excel.Range
Dim vLeft As Variant, vTop As Variant
Dim sURL As String

Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"

If Updateable = False Then
    URL_QRCode_SERIES = "outdated"
    Exit Function
End If

Set oRng = Application.Caller.Offset(, 1)
On Error Resume Next
Set oPic = oRng.Parent.Shapes(PictureName)
If Err Then
    Err.Clear
    vLeft = oRng.Left + 4
    vTop = oRng.Top
Else
    vLeft = oPic.Left
    vTop = oPic.Top
    PictureSize = Int(oPic.Width)
    oPic.Delete
End If
On Error GoTo 0

If Len(QR_Value) = 0 Then
    URL_QRCode_SERIES = CVErr(xlErrValue)
    Exit Function
End If

sURL = sRootURL & _
       sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
       sTypeChart & sJoinCHR & _
       sDataParameter & UTF8_URL_Encode(VBA.Replace(QR_Value, " ", "+"))

Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
oPic.Name = PictureName
URL_QRCode_SERIES = DisplayText
End Function



Файл "По кнопке". Работает через оффлайн компоненту. По кнопке.
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Sub setQR()
'Updated by Extendoffice 2018/8/22
    Dim xSRg As Range
    Dim xRRg As Range
    Dim xObjOLE As OLEObject
    On Error Resume Next
  
    ActiveSheet.Shapes.Range(Array("BarCodeCtrl2")).Select
    Selection.Delete
    
    'Set xSRg = Application.InputBox("Please select the cell you will create QR code based on", "Kutools for Excel", , , , , , 8)
    Set xSRg = Range("$B2")
    If xSRg Is Nothing Then Exit Sub
    'Set xRRg = Application.InputBox("Select a cell to place the QR code", "Kutools for Excel", , , , , , 8)
    Set xRRg = Range("C15")
    If xRRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    Application.CutCopyMode = True
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = "d"
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste xRRg
    xObjOLE.Delete
    Application.ScreenUpdating = True
   
End Sub



А мне нужно,чтобы работало по формуле (изменению ячейки). Но Оффлайн, через компоненту BARCODE.BarCodeCtrl (MSBCODE964.OCX)
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39850205
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Попробовал по другому. В модуле листа:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("G5")) Is Nothing Then
  
Dim xSRg As Range
 Dim xRRg As Range
 Dim xObjOLE As OLEObject
 
 Set xRRg = Range("C15")
    
 Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
 xObjOLE.Object.Style = 11
 xObjOLE.Object.Value = Target
 ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
 ActiveSheet.Paste xRRg
 xObjOLE.Delete
 
 End If
End Sub


Работает! Только пробоблема остаётся с тем, что при каждом изменении ячейки, QR код накладывается поверх старого, в итоге получаются кучи дублей. Как его найти и удалить до добавления нового или просто найти и и заменить параметры, пока не понял.(( Если кто знает простой способ, подскажите плиз. Хоть одной проблемой будет меньше.
Ну и опять же такая схема не подходит, потому что вызывается при изменении любой ячейки.

Копирую этот же код в отдельный модуль. Вызываю функцию из ячейки, и Опять код не отрабатывает.((
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Function QR_Code(ByVal QR_Value As String)
 
Dim xSRg As Range
 Dim xRRg As Range
 Dim xObjOLE As OLEObject
 
 Set xRRg = Range("C15")
    
 Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
 xObjOLE.Object.Style = 11
 xObjOLE.Object.Value = Target
 ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
 ActiveSheet.Paste xRRg
 xObjOLE.Delete
 
QR_Code = "Name"
 
End Function
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39850330
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
TorLinkQR код накладывается поверх старого, в итоге получаются кучи дублейне очень понятно, что значит "поверх". В ячейке несколько OLE-объектов? А что мешает очистить целевую ячейку перед вставкой следующего объекта?
TorLinkНу и опять же такая схема не подходит, потому что вызывается при изменении любой ячейки.Так стоит же ограничение:
Код: vbnet
1.
If Not Intersect(Target, Range("G5")) Is Nothing Then

в чем проблема?

TorLinkКопирую этот же код в отдельный модуль. Вызываю функцию из ячейки, и Опять код не отрабатывает.((Я не смог найти MSBCODE964.OCX, поэтому пробовать ваш код не могу. Вроде бы на функции, которые используются в формулах, накладываются какие-то ограничения, может быть и не заработает.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39850965
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Proв чем проблема?

Да просто смущает выполнение функции каждый раз впустую, хоть и до условия.
Попробую так сделать, с очищением ячейки.
Вот компонента: https://yadi.sk/d/ctzmKMTOYswacw
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39851266
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro В ячейке несколько OLE-объектов? А что мешает очистить целевую ячейку перед вставкой следующего объекта? подскажите, как это лучше сделать?
Код: vbnet
1.
2.
Range("C15").Select
 Selection.ClearContents


Не прокатывает. Хотя формулы и текст удаляет.
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39851703
TorLink
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Получилось немного по другому. Код выполняется по изменению ячейки.
Компоненту надо добавлять руками в инструменты разработчика.
Судя по всему на 2013м офисе и ниже не работает, т.к. просто выдаёт ошибку при добавлении.
Авось кому пригодиться, чтобы не тратить 2 недели на эти 15 строк кода.)))
...
Рейтинг: 0 / 0
Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
    #39860197
sega1999
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Народ, а не подскажете к какому офису относится файл MSBCODE932.OCX? У меня 2007-й.
Или он идет с каким-то другим продуктом?
...
Рейтинг: 0 / 0
13 сообщений из 13, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Генерация QR code в Excel. BARCODE.BarCodeCtrl.1 MSBCODE964
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]