相关文章推荐
豪情万千的双杠  ·  VBA ...·  2 周前    · 
爱运动的打火机  ·  使用 VBA ...·  2 周前    · 
性感的凉面  ·  VBA | ...·  2 周前    · 
被表白的八宝粥  ·  java.net.UnknownHostEx ...·  1 年前    · 
酷酷的枕头  ·  Apache Httpclient5 ...·  1 年前    · 

VBA记录一下遇到的转置后占用问题:(1)

Sub Xuanwj()
Dim path$, filename$, fn$
Dim arr(1 To 999, 1 To 9)
Dim arr1(1 To 999, 1 To 6)
Dim a1%, a2%, a3%, s1%, s2%, s3%, Tableno%, Rows%
Dim t As Date
Application.ScreenUpdating = False    '屏幕闪烁关闭
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
'filedialog对象的show方法显示对话框,并且返回 -1(如果你按OK) 和 0 (如果你按CANCEL)
path = .SelectedItems(1)
'MsgBox "你选择的文件夹是: " & .SelectedItems(1), vbOKOnly + vbInformation, "标题"
Else
'MsgBox "未选择"
Exit Sub
End If
End With
t = Timer
filename = Dir(path & "\*.pdf")    '对文件夹内的工作簿进行循环,循环查找的格式  *.pdf
' MsgBox filename
a1 = 1
Do While filename <> ""
'对文件夹内的工作簿进行循环,截止到最后一个工作簿
fn = path & "\" & filename    '取得循环符合条件工作簿的  文件夹地址,赋值给fn 这个变量
' MsgBox "现在汇总的工作簿是fn= " & fn
Set wordapp = CreateObject("Word.Application")
Set WordDoc = wordapp.Documents.Open(filename:=fn, ReadOnly:=True)
wordapp.Visible = False
'调用Wordapp打开PDF格式
Set WDDOC = GetObject(fn)
With WDDOC
Tableno = .Tables.Count    '文件的页数
On Error Resume Next
'复制文档中表格部分文本
For s1 = 1 To Tableno
For s2 = 1 To .Tables(s1).Range.Rows.Count
For s3 = 1 To .Tables(s1).Range.Columns.Count
arr(a1 + s2, 1 + s3) = Replace(Replace(Replace(.Tables(s1).Cell(s2, s3).Range.Text, "", ""), Chr(13), ""), "End Of PO", "")
arr(a1 + s2, 1) = Replace(Right(filename, 13), ".pdf", "")
Next
Next
a1 = a1 + s2
Next
'Debug.Print arr(44, 1) & "/" & arr(44, 2) & "/" & arr(44, 3) & "/" & arr(44, 4) & "/" & arr(44, 6) & "/" & arr(44, 7) & "/" & arr(44, 8)
End With
Set WDDOC = Nothing
WDDOC.Close False
WDDOC.Application.Quit '关闭
wordapp.Quit

filename = Dir      '进行下一步的循环
Loop
Rows = 1
For a2 = 1 To a1
If (arr(a2, 2) > 0) And (arr(a2, 2) < 999) Then
arr1(Rows, 1) = arr(a2, 1)
arr1(Rows, 2) = arr(a2, 3)
arr1(Rows, 3) = arr(a2, 4)
arr1(Rows, 4) = arr(a2, 5)
arr1(Rows, 5) = arr(a2, 6)
arr1(Rows, 6) = arr(a2, 7)
Rows = Rows + 1
End If
Next
ThisWorkbook.Worksheets(1).Cells.Clean
ThisWorkbook.Worksheets(1).Range("a1:f1") = Array("订单号", "SKU", "品名", "店名", "订货量", "单价")
ThisWorkbook.Worksheets(1).Range("a2").Resize(UBound(arr1, 1), UBound(arr1, 2)) = arr1
ThisWorkbook.Worksheets(1).Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True    '屏幕闪烁打开
Application.DisplayAlerts = True
MsgBox "转换完成,用时:" & Format(Timer - t, "###")

END SUB

1.Set wordapp = CreateObject("Word.Application")之后调用WORK(桌面)打面指定文件夹内PDF后会生成一个桌面WORK,后续不加wordapp.Quit会一直占用着(导至转置后的PDF改不了名子等操作)
2.初次把PDF调用桌面WORK格式打开时会显示对话框。如不确认并勾选不再显示程序会进入假死。
3.Replace(Replace(Replace(.Tables(s1).Cell(s2, s3).Range.Text, "", ""), Chr(13), ""), "End Of PO", "")部分PDF转WORK会生成不知名的各种乱码如""

大家好,最近推出的内容是" VBA 信息获取与处理"中的部分内容,这套教程面向中高级人员,涉及范围更广,实用性更强,现在的内容是第四个专题"EXCEL工作表数据的读取、回填和查找"的内容。第四节 将 VBA 数组写入工作表时 转置 (Transpose)的利用 转置 (Transpose)是数组应用中经常用到的知识点,在使用Excel表格的过程中,当我们想将横行转成竖列(或将纵向的数据切换成横向排列),又希望这前... 1.    在将别人的项目导入eclipse之后,出现了"sun.misc.BASE64Encoder找不到jar"的错误,我解决的办法是:右键项目》属性》Java Build Path》jre System Library 》access rules》resolution选择accessible,下面填上**点击确定即可! Shell "RUNDLL32.EXE URL.DLL,FileProtocolHandler " & myfile, vbMaximizedFocus ' myfile是 PDF 文件完整路径 Dim sr1 As Integer: sr1 = Selection.Item(1).Row Dim sr2 As Integer: sr2 = 1 Dim i As Long: i = 1 Do While i <= Selection.Count For j = ColumnStart(Selection) To ColumnEnd(Selection) 用presentations.open()方法打开遍历的PPT文件,赋值给prs对象。将打开的文件prs对象和 PDF 路径fName传递给另存、导出或打印的过程,生成 PDF 。有其他任何 VBA /办公自动化的问题也可以提问或者浏览我的主页的回答和文章。关于具体的操作方法和Word批量导出 PDF 的方法,请关注我之前的专栏文章。然后遍历这个数组,获取每个文件夹下的PPT文件,存入另一个数组drr。遍历前面的drr,同时把拼接出导出的 PDF 文件的路径fName。完成,关闭打开的DPF文件prs。... EXCEL VBA PDF 1.使用CreateObject("Wscript.Shell").Run(" pdf 文件路径") 2.可以使用foxit Activex 或者 adobe 的activex workbookS.open(" PDF 的路径") 在Word 2013里面,我们可以打开一个 PDF 文件,并对其进行编辑,重新保存后,实现将 PDF 文件转换为Word文件 下面由简单的代码 VBA 代码实现将某个目录下所有的 PDF 文件转为Word文件 Sub Pdf toWord() Dim file As Variant file = Dir("D:\OfficeDev\Word\201505\ Pdf \" & "*. pdf ")