代码生成的二维码都是放在指定一个单元格内，那要是合并后的单元格改怎么修改代码？

li446425169

需求：目前生成的二维码只能放在一个单元格内，要是想把二维码放在合并后的大单元格内改怎么修改代码？比如合并后的G3,G4，想要的效果就是二维码处在合并后的大单元格内水平居中，提前谢谢大神帮助

yaozong

Sub 生成二维码()
    Application.ScreenUpdating = False
    Dim t As String
   
    For Each x In ActiveSheet.DrawingObjects
        If InStr(x.Name, "Picture") > 0 Or InStr(x.Name, "图片") > 0 Then x.Delete
    Next

        If Range("G2") <> "" Then
            t = Range("G2")
            Call QRMain(t)
            Call CreateBitmapQRCode(RGB(0, 0, 0), RGB(255, 255, 255))
            Call QRCodeToClipboard
            'Range("G3").Select'''改用下句
            Range("G3:G4").Select
            ActiveSheet.Paste
            With Selection
                'CelH = Range("G3").Height    '单元高度（改用下句）
                CelH = Range("G3").Height * 2  '单元高度
                CelW = Range("G3").Width     '单元宽度
               
                PicH = .Height    '图片高度
                PicW = .Width     '图片宽度
                PicBili = Application.WorksheetFunction.Min(CelH / PicH, CelW / PicW) * 0.96 '单元与图片之间长宽差异比例的最小值
                .Height = PicH * PicBili        '按比例调整图片宽度
                .Width = PicW * PicBili         '按比例调整图片高度
               ' .Top = Range("G3").Top + (Range("G3").Height - .Height) / 2  '垂直居中:（改用下句）
                .Top = Range("G3").Top ' + (Range("G3").Height - .Height) / 2  '垂直居中:
                .Left = Range("G3").Left + (Range("G3").Width - .Width) / 2    '水平居中:
            End With
        End If

    Range("A2").Select
   
End Sub

yaozong

参考。。。。。。。。。。。。。

li446425169

yaozong 发表于 2019-10-30 15:39
参考。。。。。。。。。。。。。

大神，谢谢你。你帮我修改的还有一个小小问题，当列宽大于行高时一切正常，当列宽小于行高时二维码处于合并后的顶端，再次谢谢。

zyg365

yaozong 发表于 2019-10-30 15:39
参考。。。。。。。。。。。。。

大师，能不能把这个二维码制作到窗体的图片控件上，谢谢

li446425169

问题解决了，比如原位置是G3,替换成G3:G4就行，如果是合并好几个单元格那就替换为F3:G4.谢谢大家了