1234
返回列表 上一主題 發帖

有關插入圖片的問題

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
25# 跳轉到 »
發表於 2012-10-14 21:56 | 只看該作者
回復 24# GBKEE [
回版大，這個語法執行之後，另存的那個檔案裡面還是會有原來的語法存在。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
24#
發表於 2012-10-14 20:44 | 只看該作者
回復 23# skyutm
20# 的程式碼有修改空間
  1. Option Explicit
  2. Sub Ex() '練習試試看   活頁簿,工作表: 須皆沒上鎖的狀態
  3.     Workbooks(1).Sheets(1).Copy            ' Sheets(1) 請先製作VBA巨集
  4.     'Workbooks("TEST").Sheets("TEST").Copy   ' Sheets(1) 請先製作VBA巨集
  5.     With ActiveWorkbook
  6.         Application.DisplayAlerts = False
  7.         .SaveAs "d:\無巨集.xlsx", FileFormat:=51 ' xlExcel8
  8.          '**  副檔名:xlsx  為無VBA巨集 的活頁簿
  9.         Application.DisplayAlerts = False
  10.     End With
  11. End Sub
複製代碼

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
23#
發表於 2012-10-14 18:41 | 只看該作者
回復 21# GBKEE
版大你誤解了，因為那個工作表「成績儲存」，裡面的語法會需要其他工作表的資料，所以另存新檔後（重新建立一個只有工作表的檔案），語法就會出現超出索引值範圍（因為其他工作表不見了），所以並不是語法上的錯誤。

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
22#
發表於 2012-10-14 16:42 | 只看該作者
最後還是要說明一下！小弟的成績系統到目前為止可以說是全部完成。小弟的參考書目是：1.EXCEL超圖解VBA基礎講座2.EXCELVBA功能索引式參考手冊
另外要感謝的是兩位版大，一位是GBKEE一位是Hseih，還有論壇上各位熱心的先進，很多語法的知識，是在書上沒有辦法找到，如果沒有大家的協助，小弟可能要再花上更多的時間也無法完成，在這個你我不相識的網路世界，真是難能可貴之事，在此要再次表達感謝之意。謝謝大家的幫忙！（不是得獎感言啦）

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
21#
發表於 2012-10-14 16:41 | 只看該作者
回復 20# skyutm
語法執行之後，還是會有語法錯誤
是哪一行程式碼錯誤,錯誤值是多少,或是附檔看看.

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
20#
發表於 2012-10-14 16:34 | 只看該作者
回復 19# GBKEE
版大您好！百忙之中又打擾了。您給的語法執行之後，還是會有語法在（所以會產生錯誤），而另外一個舊網頁所談的刪除工作表的巨集語法，在vba好像不能使用，最後小弟繞了一條遠路。就是：
1.先新增一新工作表
2.複製要複製的工作表
3.貼上時使用有條件的貼上選項（這樣就不上複製到工作表內的語法了）
PasteSpecial Paste:=xlPasteValues
PasteSpecial Paste:=xlPasteFormats
4.然後就是之前的語法
全部是
Sub macor24()
    '解除保護「成績儲存」表格↓'
    Sheets("成績儲存").Unprotect Password:="6323"
    ActiveWorkbook.Unprotect Password:="6323"
    '解除保護「成績儲存」表格↑'
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("成績儲存").Activate
    Sheets("成績儲存").Cells.Copy
    Sheets(Sheets.Count).Range("a1").PasteSpecial Paste:=xlPasteValues
    Sheets("成績儲存").Activate
    Sheets("成績儲存").Cells.Copy
    Sheets(Sheets.Count).Range("a1").PasteSpecial Paste:=xlPasteFormats
    Dim a, b, u, v, r, n As String
    a = Sheets("基本設定").Range("a6").Value
    b = Sheets("基本設定").Range("a8").Value
    u = Sheets("基本設定").Range("j1").Value
    v = Sheets("基本設定").Range("j2").Value
    r = "C:\Documents and Settings\Administrator\桌面\"
    n = a & "學年度" & b & "學期" & u & "年" & v & "班成績檔"
    Sheets(Sheets.Count).Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=r & n & ".xls", _
    FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Workbooks(1).Activate
    Sheets(Sheets.Count).Delete
    '保護「成績儲存」表格↓'
    Sheets("成績儲存").Activate
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("成績儲存").Protect Password:="6323"
    ActiveWorkbook.Protect Password:="6323"
    '保護「成績儲存」表格↑'
    Workbooks(2).Activate
    ActiveWorkbook.Close savechanges:=True
End Sub
（抱歉！不是班門弄斧啦，想說以後有人需要，可以參考一下。）

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2012-10-14 07:17 | 只看該作者
本帖最後由 GBKEE 於 2012-10-14 14:29 編輯

回復 18# skyutm
副檔名 .xlsx 為2003以上的版本 存為無巨集的活頁簿 應該沒有你說的問題

如是2003版可試試看  如執行有錯誤 請看  http://gb.twbts.com/index.php?topic=751.8
  1. Sub macor24()
  2.     Dim a, b, u, v, r, n As String, xlVbc As Object
  3.     a = Sheets("基本設定").Range("a6").Value
  4.     b = Sheets("基本設定").Range("a8").Value
  5.     u = Sheets("基本設定").Range("j1").Value
  6.     v = Sheets("基本設定").Range("j2").Value
  7.     r = "C:\Documents and Settings\Administrator\桌面\"
  8.     n = a & "學年度" & b & "學期" & u & "年" & v & "班成績檔"
  9.     Sheets("成績儲存").Copy
  10.     Sheets(1).Copy
  11.     Application.DisplayAlerts = False
  12.     With ActiveWorkbook
  13.         For Each xlVbc In .VBProject.VBComponents
  14.             xlVbc.CodeModule.DeleteLines 1, xlVbc.CodeModule.CountOfLines
  15.         Next
  16.         .SaveAs Filename:=r & n & ".xls"
  17.     End With
  18.     ThisWorkbook.Close savechanges:=True
  19. End Sub
複製代碼

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
18#
發表於 2012-10-13 23:03 | 只看該作者
回復 16# GBKEE
抱歉！狗腿是有目的的，還有一個未解開的問題要請教！
小弟的構想是想要在成績輸入完成之後另存新檔，也在本論壇和網路上做過功課，修改後的語法如下
Sub macor24()
Dim a, b, u, v, r, n As String
    a = Sheets("基本設定").Range("a6").Value
    b = Sheets("基本設定").Range("a8").Value
    u = Sheets("基本設定").Range("j1").Value
    v = Sheets("基本設定").Range("j2").Value
    r = "C:\Documents and Settings\Administrator\桌面\"
    n = a & "學年度" & b & "學期" & u & "年" & v & "班成績檔"
    Sheets("成績儲存").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=r & n & ".xlsx", _
    FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ThisWorkbook.Close savechanges:=True
End Sub
也如預期般可以在桌面存成另一個新檔，但是問題來了，因為這個工作表內有vba程式語法，所以另存新檔後，便會出現問題，就是有些語法會超出範圍，想請教一下，在複製工作表時有無選項，可以不用複製到裡面的語法嗎？再次感謝！

TOP

skyutm

帖子
84 
主題
13 
精華
0 
積分
104 
點名
0  
作業系統
XP 
軟體版本
SP3 
閱讀權限
20 
性別
男 
註冊時間
2012-8-10 
最後登錄
2018-4-21 
17#
發表於 2012-10-13 20:27 | 只看該作者
回復 16# GBKEE

啊！我懂了，版大就是比較聰明（狗腿），把貼上的圖片加上編號，就可以準確控制已貼上圖片的移動位置，也就不會移動到其他圖片了。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
16#
發表於 2012-10-13 08:07 | 只看該作者
本帖最後由 GBKEE 於 2012-10-13 08:24 編輯

回復 15# skyutm
  1. With Sheets("成績單")
  2.     For i = 0 To j
  3.              .Paste Destination:=.Range("d" & 22 + 26 * i)
  4.     Next i
  5.              .Pictures.ShapeRange.IncrementLeft 45
  6.              .Pictures.ShapeRange.IncrementTop 5
  7.            '**** 也會跟著移動*****       .Pictures -> Sheets("成績單")的所有圖片
  8.     End With
複製代碼
試試看
  1. With Sheets("成績單")
  2.     For i = 0 To j
  3.              .Paste Destination:=.Range("d" & 22 + 26 * i)
  4.               a = .Pictures.Count
  5.              .Pictures(a).ShapeRange.IncrementLeft 45
  6.              .Pictures(a).ShapeRange.IncrementTop 5
  7.     Next i
  8.     End With
複製代碼

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
1234
返回列表 上一主題