excel自动生成QR Code

jygzcj

Option Explicit

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
   
    Dim LR As Long
    Dim i As Long
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    If LR < 2 And Cells(1, 1) = "" Then Exit Sub
    Dim RngShp As Shape
    For Each RngShp In Sheet1.Shapes
        If RngShp.Name Like "*Picture*" Then
            RngShp.Delete
        End If
    Next
   
    Dim RangeWidth As Single
    Dim RangeHeight As Single
    Dim RangeDim As Single
   
    For i = 1 To LR
        Dim Result As Boolean
        Result = Application.Run("GetQRCode", "QR Code", Cells(i, 1).Value, 200, 200)
        If Result Then
            On Error Resume Next
            Cells(i, 2).Select
            RangeWidth = Cells(i, 2).Width
            RangeHeight = Cells(i, 2).Height
            If RangeWidth < RangeHeight Then
                RangeDim = RangeWidth
                Else
                RangeDim = RangeHeight
            End If
            Paste
            
            With Selection
                .ShapeRange.Width = RangeDim * 0.8
                .ShapeRange.Height = RangeDim * 0.8
                .ShapeRange.Left = Cells(i, 2).Left + (RangeWidth - .ShapeRange.Width) / 2
                .ShapeRange.Top = Cells(i, 2).Top + (RangeHeight - .ShapeRange.Height) / 2
            End With
            
            
        End If
    Next
    Cells(1, 1).Select
   
   Application.ScreenUpdating = True
End Sub

YANWEI82123300

最好做个例子!

jygzcj

YANWEI82123300 发表于 2024-3-16 13:42
最好做个例子!

64位的用64的，32位的用32的，可以自动生成 QR Code

zhumin1025

GetQRCode  这个在哪里引用？

YANWEI82123300

jygzcj 发表于 2024-3-16 16:13
64位的用64的，32位的用32的，可以自动生成 QR Code

QRCode没有控件呀!点击后没有二维码生成呀

jygzcj

两个文件都要打开才有用。

jygzcj

一个.xlll(32,64位的）根据你的excel版本来，另外一个 .xlsm打开即可。

YANWEI82123300

jygzcj 发表于 2024-3-17 12:57
两个文件都要打开才有用。

你的例子只有一个excel'文件,不知你所说的两个文件只得是什么?

玫瑰蝴蝶雨

没有你说的“一个.xlll(32,64位的）根据你的excel版本来”

opiona

21楼 https://club.excelhome.net/thread-1535960-1-1.html

可以纯VBA代码实现生成二维码