vba实现二维码code-128码和code-39码

林程乐

liu0wei2008 发表于 2024-12-9 15:02
循环什么的你来加吧，路径自己改下，代码放到CurBar = 0这句后面，这是Code128的

朋友，您果然厉害，去除不能运行的那一句，能将这些一条一条小形状合成一个大形状。虽然不是图片格式，但也很好。

林程乐

liu0wei2008 发表于 2024-12-9 15:02
循环什么的你来加吧，路径自己改下，代码放到CurBar = 0这句后面，这是Code128的

朋友。您果厉害把你的代码后面加几句

1. With Selection.ShapeRange.Group
   
2.     .Select
   
3.     .CopyPicture 1, -4147
   
4.     .Delete
   
5. End With
   
6. ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False

复制代码

居然完美生成图片了

liu0wei2008

wcj6376tcp 发表于 2024-12-9 19:19
现在 pic.tpye=6  是msoGroup了  ActiveSheet.Shapes(Selection.Name).SaveAsPicture "D:\\桌面\" + Sele ...

我这里是WPS测试没问题，可以保存下来，估计跟excel有些兼容性问题，没装excel不好测试，思路就是生成的线条进行组合，再将组合另存为图片

liu0wei2008

林程乐 发表于 2024-12-9 22:00
您好，卡在这一句ActiveSheet.Shapes(Selection.Name).SaveAsPicture "D:\\桌面\" + Selection.Name + ". ...

思路就是生成的线条进行组合，再将组合另存为图片，你看我的代码里新加了个arr字典，就是储存线条name的

liu0wei2008

林程乐 发表于 2024-12-9 22:36
朋友。您果厉害把你的代码后面加几句
居然完美生成图片了

这个是复制为图片吧，这样也可以的

林程乐

改好了。安照高手liu0wei2008的思路加入了字典收集线条。后复制成图片。失去了X.Y坐标。用选择单元格来实现批量生成。等下上传附件。各位看看有什么要改进的地方，耗时一天半。本人vba只学了一点点。

林程乐

附件，给大家分享，看看有什么要改进。

林程乐

liu0wei2008 发表于 2024-12-9 15:02
循环什么的你来加吧，路径自己改下，代码放到CurBar = 0这句后面，这是Code128的

高手朋友，多谢您的加入字典思路，改好了，附件在17楼

林程乐

wcj6376tcp 发表于 2024-12-9 19:19
现在 pic.tpye=6  是msoGroup了  ActiveSheet.Shapes(Selection.Name).SaveAsPicture "D:\\桌面\" + Sele ...

多谢参与，安照上一高手思路，能收集线条复制成图片，附件已经上传。

liu0wei2008

林程乐 发表于 2024-12-10 15:53
高手朋友，多谢您的加入字典思路，改好了，附件在17楼

怪了，你的那句存图片的我这里跑不通
最后那段改成这样你试试可以不

1. Set grp = ActiveSheet.Shapes.Range(d.items).Group
   
2. grp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
3. ActiveSheet.Paste
   
4. With Selection
   
5.     ActiveSheet.Shapes(.Name).SaveAsPicture ThisWorkbook.Path & "" + Selection.Name + ".png"
   
6.     .Delete
   
7. End With
   
8. grp.Delete

复制代码