word vba将图片由左而右汇入WORD表格内

sahe

K1.rar (1.06 MB, 下载次数: 16)

2019-4-13 16:12 上传

点击文件名下载附件
k2

K1.RAR为图片文件,K2.RAR内K1.DOC为范本,K2.DOC为我要的结果,依图片多寡生成K2.DOC麻烦高手帮忙.

用word vba

413191246se

楼主，请将图片统一缩放到适当大小后试用下面的宏：

1. Sub test插入图片()
   
2.     Dim t As Table
   
3.     For Each t In ActiveDocument.Tables
   
4.         With t.Range
   
5.             .Cells(12).Range.InlineShapes.AddPicture FileName:="D:\K1" & Replace(Replace(.Cells(11).Range.Text, vbCr, ""), Chr(7), "") & ".jpg"
   
6.             .Cells(14).Range.InlineShapes.AddPicture FileName:="D:\K1" & Replace(Replace(.Cells(13).Range.Text, vbCr, ""), Chr(7), "") & ".jpg"
   
7.             .Cells(16).Range.InlineShapes.AddPicture FileName:="D:\K1" & Replace(Replace(.Cells(15).Range.Text, vbCr, ""), Chr(7), "") & ".jpg"
   
8.             .Cells(18).Range.InlineShapes.AddPicture FileName:="D:\K1" & Replace(Replace(.Cells(17).Range.Text, vbCr, ""), Chr(7), "") & ".jpg"
   
9.         End With
   
10.     Next
    
11. End Sub

复制代码

sahe

413191246se 发表于 2019-4-15 00:35
楼主，请将图片统一缩放到适当大小后试用下面的宏：

如果图片多张就不行`

413191246se

楼主，如果图片多张，你只须保证每个页面的表格是一样的就行！现在你的图片要统一缩小到适当的尺寸才可以（需要用到类似《图片统一调整尺寸》宏），因为代码是循环的，多少张图片都行（对了，图片文件夹的文件名必须是 K1，并且在 D 盘根下）。

sahe

413191246se 发表于 2019-4-28 09:44
楼主，如果图片多张，你只须保证每个页面的表格是一样的就行！现在你的图片要统一缩小到适当的尺寸才可以（ ...

K3.rar (17.35 KB, 下载次数: 12)

2019-4-28 13:53 上传

点击文件名下载附件
aa

[attach]老师帮忙修改以K1A.DOC为范本,生成K1B.DOC,

依据txt数据多寡生成表格

413191246se

1. Sub txt转表格()
   
2. '说明：请打开 Word，关闭所有文档。然后将 k1a.txt 拖动到 Word 界面打开，再执行本宏即可。
   
3. '未完全按照你的原文档去做，因为现在这样分栏比较简单，可不可以呢？
   
4.     With ActiveDocument.PageSetup
   
5.         .TopMargin = CentimetersToPoints(2)
   
6.         .BottomMargin = CentimetersToPoints(2)
   
7.         .LeftMargin = CentimetersToPoints(2)
   
8.         .RightMargin = CentimetersToPoints(2)
   
9.     End With
   
10. 
    
11.     With Selection
    
12.         .WholeStory
    
13.         .ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=4, AutoFitBehavior:=wdAutoFitFixed
    
14.         .Tables(1).Style = "网格型"
    
15.         .MoveEnd
    
16.         CommandBars.FindControl(ID:=122).Execute
    
17.         .MoveEnd 1, -1
    
18.         .Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
19.         ActiveDocument.Paragraphs.Last.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
    
20.         .HomeKey Unit:=wdStory
    
21.         .InsertRowsAbove 1
    
22.         .TypeText Text:="点号"
    
23.         .MoveRight Unit:=wdCell
    
24.         .TypeText Text:="纵坐标(N)"
    
25.         .MoveRight Unit:=wdCell
    
26.         .TypeText Text:="横坐标(E)"
    
27.         .MoveRight Unit:=wdCell
    
28.         .TypeText Text:="高程"
    
29.         .Rows(1).Range.Bold = True
    
30.         .Rows(1).Range.Font.Name = "黑体"
    
31.         .Rows.Height = CentimetersToPoints(0.9)
    
32.         .Rows.HeadingFormat = True
    
33.         With ActiveDocument.PageSetup.TextColumns
    
34.             .SetCount NumColumns:=2
    
35.             .Spacing = CentimetersToPoints(0.47)
    
36.         End With
    
37.         .SplitTable
    
38.         .TypeText Text:="成   果   表"
    
39.         .InsertBreak Type:=wdSectionBreakContinuous
    
40.         .Delete Unit:=wdCharacter, Count:=1
    
41.         ActiveDocument.Paragraphs(1).Range.Select
    
42.         .MoveEnd 1, -1
    
43.         .Paragraphs(1).Range.PageSetup.TextColumns.SetCount NumColumns:=1
    
44.         With ActiveDocument.Paragraphs(1).Range
    
45.             .Style = wdStyleHeading1
    
46.             .ParagraphFormat.Alignment = wdAlignParagraphCenter
    
47.         End With
    
48.         .EndKey Unit:=wdStory
    
49.         .TypeText Text:=Space(46) & "制表者：               校核者："
    
50.         .Paragraphs(1).Range.ParagraphFormat.SpaceBefore = 16
    
51.         .Expand 4
    
52.         .HomeKey 5
    
53.         .InsertBreak Type:=wdSectionBreakContinuous
    
54.         .Paragraphs(1).Range.PageSetup.TextColumns.SetCount NumColumns:=1
    
55.     End With
    
56. 
    
57.     With ActiveDocument.Tables(1)
    
58.         .Select
    
59.         .AutoFitBehavior (wdAutoFitContent)
    
60.         .AutoFitBehavior (wdAutoFitContent)
    
61.         .AutoFitBehavior (wdAutoFitWindow)
    
62.         .AutoFitBehavior (wdAutoFitWindow)
    
63.     End With
    
64.     Selection.HomeKey Unit:=wdStory
    
65. End Sub

复制代码

sahe

413191246se 发表于 2019-4-29 10:46

WORD2010执行出现错误,能够增加寻找档案再汇入表格

413191246se

楼主，在我 Word2003 中代码运行正常，但在你的 2010 中我恐怕爱莫能助了，请自行探索或百度或询问。

sahe

413191246se 发表于 2019-5-1 00:57
楼主，在我 Word2003 中代码运行正常，但在你的 2010 中我恐怕爱莫能助了，请自行探索或百度或询问。

WORD2010执行出现错误,能够增加寻找档案再汇入表格