Forum Mjukvara Programmering och digitalt skapande Tråd Inlägg

Generera QR-kod i Excel

1
Skriv svar
Permalänk
Medlem
●

Generera QR-kod i Excel

Hej,

Jag har för tillfället denna koden i arbetet för att skriva ut en pallflagga:

filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(3, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath)
        .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
        .Left = ActiveSheet.Range("I1").Left
        .Top = ActiveSheet.Range("C4").Top
        .Width = ActiveSheet.Range("A1:B1").Width
        .Height = ActiveSheet.Range("A1:A5").Height
        .Placement = 1
    End With

Men det verkar vara något strul med api.qrserver.com och nu uppdateras inte dom 4 QR-koderna när jag kör anropet.

Någon som kan hjälpa mig med en lokal lösning som inte är avhängd av ett anrop mot en extern QR-konverter?

Tack!

Redigera
Citera flera Citera
Permalänk
Medlem ★
●

Api'et verkar fortfarande fungera, och låter enligt mig som det fortsatt bästa sättet att få QR-koder i excel.

tex https://api.qrserver.com/v1/create-qr-code/?size=150x150&data...

Visa signatur

CPU: Ryzen 9 3900x Noctua NH-D14 MOBO: TUF Gaming X570-PLUS GPU: GTX 980 RAM: 32 GB 3200 MHz Chassi: R4 PSU: Corsair AX860 Hörlurar: SteelSeries 840 Mus: Logitech G502 Lightspeed V.v. nämn eller citera mig för att få svar.

Redigera
Citera flera Citera
Permalänk
Medlem
●
Skrivet av Haptic:

Api'et verkar fortfarande fungera, och låter enligt mig som det fortsatt bästa sättet att få QR-koder i excel.

tex https://api.qrserver.com/v1/create-qr-code/?size=150x150&data...

Gå till inlägget

Ja, det fungerar när jag kör 1 anrop. Men inte 4 samtidigt i koden i Excel. Det har fungerat fram tills idag, så jag funderar på om dom har satt någon slags "limit" för flera anrop på samma gång, att det kanske tolkas som någon slags "spam" ?

Men helst vill jag ju ha en lokal lösning som inte förlitar sig på om sidan är uppe eller ej.

Redigera
Citera flera Citera
Permalänk
Medlem ★
●
Skrivet av RobinJacobsson:

Men helst vill jag ju ha en lokal lösning som inte förlitar sig på om sidan är uppe eller ej.

Gå till inlägget

Finns en drös med NodeJS-paket som kan lösa det till dig alt olika Docker-instanser. Allt kan du köra lokalt men kräver väl kanske nån timmas meck för att få igång.

Redigera
Citera flera Citera
Permalänk
Medlem
●

Jag hittade en lösning på detta efter en längre tids letande, som fler kanske kan ha nytta av.

https://www.extendoffice.com/documents/excel/5404-excel-creat...

Någon VBA-kunnig som kan implementera detta i min kod?

Jag vill ha 4 QR-koder uppdaterade när jag aktiverar mitt makro.
Först tar den bort alla gamla QR-koder, sedan sätter den in 4 nya + loggan som försvinner när alla gamla bilder raderas i början.

Min kod:

Sub addQR()

    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic

    filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(3, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath)
        .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
        .Left = ActiveSheet.Range("I1").Left
        .Top = ActiveSheet.Range("C4").Top
        .Width = ActiveSheet.Range("A1:B1").Width
        .Height = ActiveSheet.Range("A1:A5").Height
        .Placement = 1
    End With
    
    filepath2 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(5, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath2)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("G11").Left
    .Top = ActiveSheet.Range("G11").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
        filepath3 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(7, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath3)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("E21").Left
    .Top = ActiveSheet.Range("E21").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
        filepath4 = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(9, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath4)
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("L21").Left
    .Top = ActiveSheet.Range("L21").Top
    .Width = ActiveSheet.Range("A1:B1").Width
    .Height = ActiveSheet.Range("A1:A5").Height
    .Placement = 1
    End With
    
    picPath = "O:\Robin\Dokument\logga.jpg"
    
With ActiveSheet.Pictures.Insert(picPath)
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.ScaleWidth 1.78, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleHeight 1.24, msoFalse, msoScaleFromTopLeft
    .Left = ActiveSheet.Range("B3").Left
    .Top = ActiveSheet.Range("B3").Top
    .Placement = 1
  End With
    
End Sub

Koden jag hittade:

Sub setQR()
'Updated by Extendoffice 2018/8/22
    Dim xSRg As Range
    Dim xRRg As Range
    Dim xObjOLE As OLEObject
    On Error Resume Next
    Set xSRg = Application.InputBox("Please select the cell you will create QR code based on", "Kutools for Excel", , , , , , 8)
    If xSRg Is Nothing Then Exit Sub
    Set xRRg = Application.InputBox("Select a cell to place the QR code", "Kutools for Excel", , , , , , 8)
    If xRRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = xSRg.Text
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste xRRg
    xObjOLE.Delete
    Application.ScreenUpdating = True
End Sub
Redigera
Citera flera Citera
Permalänk
Medlem
●

Jag har fått det att fungera så långt att jag kan importera QR-koden.

Däremot skapas det en förhållandevis stor border/vit kant runt streckkoden som jag inte lyckas få bort. Vet egentligen inte vad jag sysslar med, men bifogar koden jag googlat mig fram.

    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic

    Dim xObjOLE As OLEObject
    On Error Resume Next

    Application.ScreenUpdating = False
    Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    xObjOLE.Object.Style = 11
    xObjOLE.Object.Value = [R3].Text
    xObjOLE.Width = 100
    'xObjOLE.ShapeRange.Fill.Transparency = 1
    'xObjOLE.Border.Weight = 0
    
    ActiveSheet.Shapes.Item(xObjOLE.Name).Copy
    ActiveSheet.Paste Destination:=Worksheets("Blad1").Range("I4")
    xObjOLE.Delete
    Application.ScreenUpdating = True

Ingen av dom som jag satt som kommentar fungerar. Det är ungefär vad jag hittat och testat, med lite modifikationer.

Redigera
Citera flera Citera
Permalänk
Medlem ★
●

@RobinJacobsson Har du provat att fråga chatGPT-3/-4 om fingervisningar eller är det ej tillåtet/möjligt i ditt sammanhang?

Mvh,
WKL.

Visa signatur

"Den säkraste koden är den som aldrig skrivs"
"Visste du förresten att det är ett mångmiljardbolag?"
"Jag lever inte för att koda utan kodar för att sen kunna leva"

Redigera
Citera flera Citera
Permalänk
Medlem
●
Skrivet av WebbkodsFrilansaren:

@RobinJacobsson Har du provat att fråga chatGPT-3/-4 om fingervisningar eller är det ej tillåtet/möjligt i ditt sammanhang?

Mvh,
WKL.

Gå till inlägget

Hej,

Jag provade precis men svaret jag fick var detta:

The BARCODE.BarCodeCtrl.1 control does not provide a direct way to set the size of the border around the QR code. However, you can adjust the size of the control and the QR code itself to achieve the desired border size.

Here's an example code that sets the Size property of the BARCODE.BarCodeCtrl.1 control to 150 and the ModuleSize property to 5. This should increase the size of the QR code and reduce the size of the border around it:

vbnet
Copy code
Dim xObjOLE As OLEObject
On Error Resume Next

Application.ScreenUpdating = False
Set xObjOLE = ActiveSheet.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
xObjOLE.Object.Style = 11
xObjOLE.Object.Size = 150
xObjOLE.Object.ModuleSize = 5
You can experiment with different values for the Size and ModuleSize properties to achieve the desired border size. Note that increasing the Size property too much may cause the QR code to become pixelated and unreadable.

Testade både 'Size' och 'ModuleSize' utan någon förändring alls.

Redigera
Citera flera Citera
Permalänk
Medlem ★
●
Skrivet av RobinJacobsson:

Hej,

Jag har för tillfället denna koden i arbetet för att skriva ut en pallflagga:

filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data..." & Cells(3, 18).Value
    
    With ActiveSheet.Pictures.Insert(filepath)
        .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
        .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
        .Left = ActiveSheet.Range("I1").Left
        .Top = ActiveSheet.Range("C4").Top
        .Width = ActiveSheet.Range("A1:B1").Width
        .Height = ActiveSheet.Range("A1:A5").Height
        .Placement = 1
    End With

Men det verkar vara något strul med api.qrserver.com och nu uppdateras inte dom 4 QR-koderna när jag kör anropet.

Någon som kan hjälpa mig med en lokal lösning som inte är avhängd av ett anrop mot en extern QR-konverter?

Tack!

Gå till inlägget

Detta kanske kan vara något?
https://www.activebarcode.com/commandline/

EDIT
Licensen för en dator är 3800:- kan ju vara värt det.

Senast redigerat
Redigera
Citera flera Citera
1
Skriv svar