希望在当前xls中复制某个 sheet，应该怎么做

masterlong

只知道如何新增工作表
但那只是一个空白的工作表
我希望的是将一个工作表完全复制
就好像excel菜单中的“移动或复制工作表”
查了很久没找到
有谁知道吗

Gu_xl

masterlong 发表于 2013-4-10 01:06
G斑真是牛得一塌糊涂啊
还有两个问题再请教一下

;;复制Excel整个表单示例代码：By Gu_xl

1. (defun c:tt (/ XLSFILE XLAPP SH1 SHEETS I FLAG SH2)
   
2.   (cond
   
3.     ((not
   
4.        (setq xlsfile (getfiled "打开Excel文件" "test.xls" "xls" 4))
   
5.        )
   
6.      )
   
7.     ((VL-CATCH-ALL-ERROR-P
   
8.        (setq xlapp (VL-CATCH-ALL-APPLY
   
9.                      'vlax-get-or-create-object
   
10.                      (list "Excel.Application")
    
11.                      )
    
12.              )
    
13.        )
    
14.      (alert "不能创建EXCEL应用程序")
    
15.      )
    
16.     (t
    
17.      (vlax-invoke-method
    
18.        (vlax-get-property xlapp 'WorkBooks)
    
19.        'Open
    
20.        xlsfile
    
21.        )
    
22.      (if (not
    
23.            (VL-CATCH-ALL-ERROR-P
    
24.              (setq sh1
    
25.                     (VL-CATCH-ALL-APPLY
    
26.                       'vlax-get-property
    
27.                       (list
    
28.                         (setq sheets
    
29.                                (vlax-get-property Xlapp "sheets")
    
30.                               )
    
31.                         'item
    
32.                         "Sheet1" ;_ 要复制的表单，具体名称可自己修改
    
33.                         )
    
34. 
    
35.                       )
    
36.                    )
    
37.              )
    
38.            )
    
39.        (progn
    
40.          ;;复制整个表单内容
    
41.          (vlax-invoke-method sh1 'copy sh1)
    
42.          (setq i 0
    
43.                flag t
    
44.                )
    
45.          (vlax-for sh sheets
    
46.            (if flag
    
47.              (if (equal sh sh1)
    
48.                (setq flag nil)
    
49.                (setq i (1+ i))
    
50.                )
    
51.              )
    
52.            )
    
53.          (setq sh2 (vlax-get-property sheets 'item i)) ;_ 取得复制后的表单
    
54.          (vlax-put-property sh2 'name "NewSheetAA") ;_ 修改复制后的表单名称
    
55.          )
    
56.        )
    
57.      (vlax-invoke-method
    
58.        (vlax-get-property Xlapp "ActiveWorkbook")
    
59.        "Save"
    
60.        ) ;_ 存盘
    
61.      (vla-put-visible xlapp 1) ;_ 显示Excel
    
62.      (vlax-release-object Xlapp) ;_ 释放内存
    
63.      )
    
64.     )
    
65.   (princ)
    
66.   )

(defun c:tt (/ XLSFILE XLAPP SH1 SHEETS I FLAG SH2)<br />   (cond<br />     ((not<br />        (setq xlsfile (getfiled "打开Excel文件" "test.xls" "xls" 4))<br />        )<br />      )<br />     ((VL-CATCH-ALL-ERROR-P<br />        (setq xlapp (VL-CATCH-ALL-APPLY<br />                      'vlax-get-or-create-object<br />                      (list "Excel.Application")<br />                      )<br />              )<br />        )<br />      (alert "不能创建EXCEL应用程序")<br />      )<br />     (t<br />      (vlax-invoke-method<br />        (vlax-get-property xlapp 'WorkBooks)<br />        'Open<br />        xlsfile<br />        )<br />      (if (not<br />            (VL-CATCH-ALL-ERROR-P<br />              (setq sh1<br />                     (VL-CATCH-ALL-APPLY<br />                       'vlax-get-property<br />                       (list<br />                         (setq sheets<br />                                (vlax-get-property Xlapp "sheets")<br />                               )<br />                         'item<br />                         "Sheet1" ;_ 要复制的表单，具体名称可自己修改<br />                         )<br /> <br />                       )<br />                    )<br />              )<br />            )<br />        (progn<br />          ;;复制整个表单内容<br />          (vlax-invoke-method sh1 'copy sh1)<br />          (setq i 0<br />                flag t<br />                )<br />          (vlax-for sh sheets<br />            (if flag<br />              (if (equal sh sh1)<br />                (setq flag nil)<br />                (setq i (1+ i))<br />                )<br />              )<br />            )<br />          (setq sh2 (vlax-get-property sheets 'item i)) ;_ 取得复制后的表单<br />          (vlax-put-property sh2 'name "NewSheetAA") ;_ 修改复制后的表单名称<br />          )<br />        )<br />      (vlax-invoke-method<br />        (vlax-get-property Xlapp "ActiveWorkbook")<br />        "Save"<br />        ) ;_ 存盘<br />      (vla-put-visible xlapp 1) ;_ 显示Excel<br />      (vlax-release-object Xlapp) ;_ 释放内存<br />      )<br />     )<br />   (princ)<br />   )

masterlong

这是找到的一些资料

【1】
应用于 Chart、Charts、Sheets、Worksheet 和 Worksheets 对象的 Copy 方法。

将指定工作表复制到工作簿的另一位置。

expression.Copy(Before, After)

expression      必需。该表达式返回上面的对象之一。

Before      Variant 类型，可选。指定某工作表，复制的工作表将置于此工作表之前。如果已经指定了 After，则不能指定 Before。

After      Variant 类型，可选。指定某工作表，复制的工作表将置于此工作表之后。如果已经指定了 Before，则不能指定 After。


【2】
应用于 Chart、Charts、Sheets、Worksheet 和 Worksheets 对象的 Copy 方法。

本示例复制工作表 Sheet1，并将其放置在工作表 Sheet3 之后。

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")


然后就不知道该怎么做了

masterlong

顶一下

附vlxls函数集中新增页的代码

;0·新增页
;|
Examples:
(vlxls-sheet-add *xlapp* "Sheet1")  ==>  T
(vlxls-sheet-add *xlapp* NIL)  ==>  T
(vlxls-sheet-add *xlapp* "NewSheet")  ==>  NIL
|;
(defun vlxls-sheet-add (xlapp Name / Rtn)
   (if (member name (vlxls-sheet-get-all xlapp))
      (setq Rtn nil)
      (progn
         (vlax-put-property
            (vlax-invoke-method
               (vlax-get-property Xlapp "sheets" )
               "Add"
            )
            "name"
            Name
         )
         (setq Rtn (equal (vlxls-sheet-get-active xlapp) name))
      )
   )
   Rtn
)

感觉复制页是可以实现的
试了很久没有结果
其实如果只是需要被复制页中的单元数值
可以旧页取值新建页中赋值
这都不是问题
但是旧页里有公式啊

Gu_xl

复制Excel的表单代码示例 如下:

游客，本帖隐藏的内容需要发帖数高于 10 才可浏览，你当前发帖数只有 0

xiaxiang

其实用一楼的excel vba代码，再翻译一下，基本就可以实现了

masterlong

Gu_xl 发表于 2013-4-9 15:44
复制Excel的表单代码示例 如下:

[/post]

G斑真是牛得一塌糊涂啊
还有两个问题再请教一下

1.
页面复制完成后
该页面处于一个全选状态
能不能让选择的区域只位于"A1"单元格?

2.
要复制的页面内含有图片
示例代码不能连图片一同复制
这个有办法解决吗?

zhangtieliang

版主真的是厉害

zhangtieliang

太猛了 无法言喻

664571221

楼主你好我没看懂是要做什么用的