[發問] 2003版程式於2007版EXCEL無法執行

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

2^#

發表於 2014-9-12 17:03 | 顯示全部帖子

DEAR GBKEE 大大
感謝您.程式確認OK.小弟公司禁止上傳檔案......
待小弟提出申請.以後即可建立範例請教各位先進
非常感謝您之指導.

羅

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

3^# 倒序看帖

打印

字體大小: tT

發表於 2014-9-16 15:12 | 顯示全部帖子

[發問] 2003版程式於2007版EXCEL無法執行

DEAR ALL 大大
  1 如表一程式於2003 EXCEL書寫後於2003 執行均無問題 ,同事經辦電腦為2007版本執行後產生如下BUG -
   1.1執行後出現  "EXCEL無法將工作表插入目的地活業簿,因為它包含的列與欄比來源活頁簿少,若要移動或覆製資料到目的地活頁簿,可以選取資料,然後使用
      "覆製"與"貼上"命另將他插入另一個活頁簿的工作表"
   1.2 程式異常處停於 Sh.Copy after:=a.Sheets(a.Sheets.Count)  此處.
2請教各位先進表一如何修改方無此  BUG.
  2.1 煩不吝賜教  THANKS *10000

表一
Sub yy()
  Dim a As Workbook, f$, fn$, k%
  Dim p$, Sh As Worksheet
  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.CSV")
  Application.ScreenUpdating = False
  Do While f <> ""
Workbooks.Open p & f
k = 0
For Each Sh In Worksheets
   If Not IsEmpty(Sh.UsedRange) Then
   fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
   Sh.Copy after:=a.Sheets(a.Sheets.Count)
   ActiveSheet.Name = fn
   k = k + 1
   End If
Next
Windows(f).Close True
f = Dir
  Loop
  Application.ScreenUpdating = True

  Sheet14.Select
  Range("A1").Select
End Sub

羅

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

4^#

發表於 2014-9-16 17:11 | 顯示全部帖子

DEAR  GBKEE大大
1 執行後停於  a_Sh.Name = fn
  秀出 "編譯錯誤.無法使用至唯讀屬性."
  請問如何除 BUG
  1.1 感謝您之不吝賜教. THANKS *10000
         Set a_Sh = a.Sheets.Add  '新增醫工作表
                  Sh.UsedRange.Copy a_Sh.[a1] '複製已使用的範圍
                  a_Sh.Name = fn
            k = k + 1

羅

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

5^#

發表於 2014-9-17 16:37 | 顯示全部帖子

Dear sir -
  依您之指導.修改如下  已可正常使用.感謝您 robert 09/18
Sub yy()
  Dim a As Workbook, f$, fn$, k%
  Dim p$, Sh, a_Sh As Worksheet

  Set a = ThisWorkbook
  p = "C:\AAA\"
  f = Dir(p & "*.CSV")
  Application.ScreenUpdating = False
  Do While f <> ""
Workbooks.Open p & f
k = 0
For Each Sh In Worksheets
   If Not IsEmpty(Sh.UsedRange) Then
   fn = IIf(k = 0, Replace(f, ".xls", ""), Replace(f, ".xls", "_") & k)
   Sh.Range("A1:Z500").Select
   Set a_Sh = a.Sheets.Add  '新增一工作表
   a_Sh.Name = fn
   Sh.UsedRange.Copy a_Sh.[a1] '複製已使用的範圍
         ActiveSheet.Name = fn
   k = k + 1
   End If
Next
Windows(f).Close True
f = Dir
  Loop
  Application.ScreenUpdating = True

  Sheet14.Select
  Range("A1").Select
End Sub

羅