Bitget下载

注册下载Bitget下载,邀请好友,即有机会赢取 3,000 USDT

APP下载   官网注册

做好的源文件模板可以去我公众号上下载,公众号搜索 ”天涯追梦54“


VBA代码、批量图片转换PDF格式

很多时候我们在网络传送的时候都要发PDF格式的文件给对方,因为PDF文件比较简单看图软件也都可以打开,打印也很方便。如果把很多张图片给别人看,你若是一张一张发送会很麻烦别人收也很麻烦,有时候还会有的图片没收到,所以这个时候我们就需要把多张图片转换成PDF格式发送给对方,PDF就一个文件别人收也方便打开看也方便,还不容易出错。

我用Excel做了一个转换pdf格式的模板,它可以批量转换多张图片。


视频加载中...
[xss_clean][xss_clean]

这视频是使用教程,不会的可以看看


VBA代码、批量图片转换PDF格式

这打开模板文件的效果。

像Excel办公软件大家电脑上都有安装使用也很方便。

下面是部份代码分享

Sub 导出PDF横()

Application.ScreenUpdating = False '关闭刷新

Dim wsu$, n

Dim spath As String

spath = Excel.ThisWorkbook.Path '当前工作薄的路径

sName = spath & "\" & "多张图片转成PDF" & ".pdf" '导出的文件名

'------------------------------------

'计算文件夹下有多少张图片

wsu = Dir(ThisWorkbook.Path & "\图片\*.jpg") '遍历文件

'------------------------------------

'插入图片

Do

n = n + 1

Worksheets.Add.Name = n '新建工作表并指名字

With ActiveSheet.PageSetup '该对象包含指定对象的所有页面设置

.Orientation = xlLandscape '您可以使用 方向 属性可以指定或确定的查看方向(横向)可以用 2 表示横向

' .Orientation = xlPortrait '您可以使用 方向 属性可以指定或确定的查看方向(纵向) 可以用 1 表示纵向

.PaperSize = xlPaperA4 '该常量指示打印时使用的纸张大小,可以用 9 表示 A4纸张

.LeftMargin = Application.CentimetersToPoints(0.4) '左 页边距设置

.RightMargin = Application.CentimetersToPoints(0) '右

.TopMargin = Application.CentimetersToPoints(0.5) '上

.BottomMargin = Application.CentimetersToPoints(0) '底

.HeaderMargin = Application.CentimetersToPoints(0) '页眉

.FooterMargin = Application.CentimetersToPoints(0) '页脚

.Zoom = 100 '缩放比例

.CenterHorizontally = True '水平居中位置打印指定工作表,则该属性值为 True

.CenterVertically = True '垂直居中位置打印指定工作表,则该属性值为 True

End With

ActiveSheet.Range("a1").ColumnWidth = 150 '为了打印边距更近点

tu1 = ThisWorkbook.Path & "\图片\" & wsu '把路径赋给变量

Dim sr As Shape

kuan = 805.6 '设置图片的宽度

gao = 584.6 '设置图片的高度

Set sr = Worksheets(n & "").Shapes.AddChart(-4100, 0, 0, kuan, gao) '新建图表壳

sr.Chart.Pictures.Insert (tu1) '将图片插入到图表里

ActiveSheet.ChartObjects("图表 1").Activate '激活图表 1

ActiveChart.Shapes.Range(Array("Picture 1")).Select '选择图表里面的第一张图片

kus = Selection.ShapeRange.Width '选择对象的宽度

gas = Selection.ShapeRange.Height '选择对象的高度

Selection.ShapeRange.IncrementLeft (kuan - kus) / 2 '选择对象水平平移

Selection.ShapeRange.IncrementTop (gao - gas) / 2 '选择对象垂直平移

ActiveSheet.Shapes("图表 1").Line.Visible = 0 '去掉图表边框

Sheet1.Activate '激活指定工作表

wsu = Dir '循环遍历所有文件

Loop Until wsu = ""

'------------------------------------

'导出PDF格式文件

ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sName, From:=1, To:=n

'Type:=xlTypePDF 文件格式

'Filename:=sName 文件保存位置和名字

'From:=1 指定从第几页开始发布(不写默认是从第一页)

'To:=n 指定从第几页结束发布(不写默认是到最后一页)

'------------------------------------

'删除工作表

For bao = 1 To n

Application.DisplayAlerts = False '禁用程序信息框提示

Worksheets(bao & "").Delete '删除指定工作表

Application.DisplayAlerts = True '启用程序信息框提示

Next

Application.ScreenUpdating = True '开启刷新

MsgBox "完成" '信息提示

End Sub