下面代码是dephi中的主要是对不同的图片进行合并
procedure TForm1.ToolButton2Click(Sender: TObject);
var
H,I,J,K: Integer;
pageCount:integer;
str,webstr:string;
base64:TBase64;
myRange,Pages1:OleVariant;
A: array of string;
strin:string;
begin
base64:=TBase64.Create;
try
pageCount:= Wordapp.Application.ActiveDocument.ActiveWindow.ActivePane.Pages.Count;
//ShowMessage(inttostr(pageCount));
for I := 1 to pageCount do // Iterate
begin
//Wordapp.Application.ActiveDocument.ActiveWindow.Panes(1).Pages
Pages1 := Wordapp.Application.ActiveDocument.ActiveWindow.ActivePane.Pages.Item(I);
myRange := Pages1.Rectangles.Item(1).Range;
if myRange.ShapeRange.Count > 1 then
begin
k:=0;
for J := 1 to myRange.ShapeRange.Count do // Iterate
begin
If myRange.ShapeRange.Item(J).AlternativeText = '' Then //根据AlternativeText判断图片的是否新添加
BEGIN
SetLength(A, K+1);
a[K] := myRange.ShapeRange.Item(J).Name;
K := K + 1 ;
End; end; // for
Wordapp.Application.ActiveDocument.Shapes.Range(^a).Select ;//这句报错说 没有找到项目
//Wordapp.Application.ActiveDocument.Shapes.Range(strin).Select ;
Wordapp.Application.Selection.ShapeRange.Group.Select;
//这里加图片验证
end; end; // for
except
on e: Exception do
begin
ShowMessage('2000');
//exit;
end;
end; // try/except
end;
对应的vba代码如下For k = 1 To ActiveDocument.ActiveWindow.ActivePane.Pages.Count '按页循环
Set Pages1 = ActiveDocument.ActiveWindow.ActivePane.Pages(k)
Set myRange = Pages1.Rectangles(1).Range
j = 0 '初始化 数组下标
For i = 1 To myRange.ShapeRange.Count '循环每页的所有图片
If myRange.ShapeRange.Count = 1 Then '当前页面就一个图片
myRange.ShapeRange.Select '选中图片 不合并 判断是否是新签字
'在这里加入 添加AlternativeText属性 用来验证图片
End If
If myRange.ShapeRange.Count > 1 Then '当前页面多个图形
If myRange.ShapeRange.Item(i).AlternativeText = "" Then '根据AlternativeText判断图片的是否新添加
ReDim Preserve a(j)
a(j) = myRange.ShapeRange.Item(i).Name
val1 = myRange.ShapeRange.Item(i).Name + "," + val1
j = j + 1
End If
End If
Next i
MsgBox val1
If UBound(a, 1) > 1 Then
ActiveDocument.Shapes.Range(a).Select
Selection.ShapeRange.Group.Select
'在这里加入 添加AlternativeText属性 用来验证图片
End If
Next k
在线等!!!!!!!主要是为什么我Wordapp.Application.ActiveDocument.Shapes.Range(^a).select 不能选中我已经把图片名录入的数组,可是在vba中可以!!!
procedure TForm1.ToolButton2Click(Sender: TObject);
var
H,I,J,K: Integer;
pageCount:integer;
str,webstr:string;
base64:TBase64;
myRange,Pages1:OleVariant;
A: array of string;
strin:string;
begin
base64:=TBase64.Create;
try
pageCount:= Wordapp.Application.ActiveDocument.ActiveWindow.ActivePane.Pages.Count;
//ShowMessage(inttostr(pageCount));
for I := 1 to pageCount do // Iterate
begin
//Wordapp.Application.ActiveDocument.ActiveWindow.Panes(1).Pages
Pages1 := Wordapp.Application.ActiveDocument.ActiveWindow.ActivePane.Pages.Item(I);
myRange := Pages1.Rectangles.Item(1).Range;
if myRange.ShapeRange.Count > 1 then
begin
k:=0;
for J := 1 to myRange.ShapeRange.Count do // Iterate
begin
If myRange.ShapeRange.Item(J).AlternativeText = '' Then //根据AlternativeText判断图片的是否新添加
BEGIN
SetLength(A, K+1);
a[K] := myRange.ShapeRange.Item(J).Name;
K := K + 1 ;
End; end; // for
Wordapp.Application.ActiveDocument.Shapes.Range(^a).Select ;//这句报错说 没有找到项目
//Wordapp.Application.ActiveDocument.Shapes.Range(strin).Select ;
Wordapp.Application.Selection.ShapeRange.Group.Select;
//这里加图片验证
end; end; // for
except
on e: Exception do
begin
ShowMessage('2000');
//exit;
end;
end; // try/except
end;
对应的vba代码如下For k = 1 To ActiveDocument.ActiveWindow.ActivePane.Pages.Count '按页循环
Set Pages1 = ActiveDocument.ActiveWindow.ActivePane.Pages(k)
Set myRange = Pages1.Rectangles(1).Range
j = 0 '初始化 数组下标
For i = 1 To myRange.ShapeRange.Count '循环每页的所有图片
If myRange.ShapeRange.Count = 1 Then '当前页面就一个图片
myRange.ShapeRange.Select '选中图片 不合并 判断是否是新签字
'在这里加入 添加AlternativeText属性 用来验证图片
End If
If myRange.ShapeRange.Count > 1 Then '当前页面多个图形
If myRange.ShapeRange.Item(i).AlternativeText = "" Then '根据AlternativeText判断图片的是否新添加
ReDim Preserve a(j)
a(j) = myRange.ShapeRange.Item(i).Name
val1 = myRange.ShapeRange.Item(i).Name + "," + val1
j = j + 1
End If
End If
Next i
MsgBox val1
If UBound(a, 1) > 1 Then
ActiveDocument.Shapes.Range(a).Select
Selection.ShapeRange.Group.Select
'在这里加入 添加AlternativeText属性 用来验证图片
End If
Next k
在线等!!!!!!!主要是为什么我Wordapp.Application.ActiveDocument.Shapes.Range(^a).select 不能选中我已经把图片名录入的数组,可是在vba中可以!!!
从网上的资料看出,这边关键是怎样把这个数组传过去。
下面是我改过来的代码,试一下
-----------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
Wordapp : OleVariant;
a : array of Variant;
begin Wordapp := createOleObject('Word.application');
Wordapp.Visible := true;
if Wordapp.Documents.count = 0 then
begin
Wordapp.Documents.Add('',0,0);
end; Wordapp.WindowState :=0;
Wordapp.Application.ActiveDocument.Shapes.AddShape(1, 10, 20, 200, 200);
Wordapp.Application.ActiveDocument.Shapes.AddShape(1, 250, 20, 200, 200);
SetLength(A, 2);
A[0] := 'Rectangle 2';
A[1] := 'Rectangle 3';
Wordapp.Application.ActiveDocument.Shapes.Range(VarArrayRef(A)).Select;//这句//
Wordapp.Application.Selection.ShapeRange.Group.Select;end;
另外请教上面的vba代码 在word2000下 能否实现,如何实现?谢谢!!
你是说你写的vba代码么?你不是说在vba中可以的.
我不太明白你在说什么,我这边的测试的就是word2000
----------------------------
确保该窗体包含名为 MultiPage1 的多页控件。Private Sub UserForm_Initialize()
Dim PageName As String
For i = 0 To MultiPage1.Count - 1
'使用索引(数值的或字符串的)
MsgBox "MultiPage1.Pages(i).Caption = " _
& MultiPage1.Pages(i).Caption
MsgBox "MultiPage1.Pages.Item(i).Caption = " _
& MultiPage1.Pages.Item(i).Caption
PageName = MultiPage1.Pages(i).Name
MsgBox "PageName = " & PageName
MsgBox "MultiPage1.Pages(PageName)" _
& ".Caption = "_
& MultiPage1.Pages(PageName).Caption
MsgBox "MultiPage1.Pages.Item(PageName)" _
& ".Caption = " & MultiPage1.Pages _
.Item(PageName).Caption
'使用 Page 对象,而不引用
'Pages 集合
If i = 0 Then
MsgBox "MultiPage1.Page1.Caption= "_
& MultiPage1.Page1.Caption
ElseIf i = 1 Then
MsgBox "MultiPage1.Page2.Caption = "_
& MultiPage1.Page2.Caption
End If '使用 SelectedItem 属性
MultiPage1.Value = i
MsgBox "MultiPage1.SelectedItem.Caption = " _
& MultiPage1.SelectedItem.Caption
Next i
End Sub
可是我在word2000下没有找到pages,你说的那个是控件的pages对象,我要的是word中的。