Board logo

標題: [發問] 有關 VBA 放入 某 EXCEL 的工作表中一事 [打印本頁]
作者: justinbaba    時間: 2014-11-3 17:30     標題: 有關 VBA 放入 某 EXCEL 的工作表中一事

抱歉~~問個非常基本的問題

因為不熟 EXCEL 所以在貴討論區中像個無頭蒼蠅到處找我要的語法..
但是又不知如何串進我自己平常用的excel 表中

目前我常用的EXCEL 的檔案中 有五個分頁  
第一個分頁  是      追貨表   (有樞紐分析功能)
第二個分頁  是      客戶購買總計    (有樞紐分析功能)
第三個分頁  是      會員資料表    ( 單純資料 )
第四個分頁  是      出貨地址清單  (有套VLOOKUP )
第五個分頁  是      採購清單    這是我想要放入 GBKEE 大之前在別的討論串留下的 程式碼..

但是我試著去貼上代碼並執行.. 並無法成功？  
這段程式碼在新的分頁中確實是能用的, 為何有會這個狀況


依 照這段程式碼..  我想在 第五分頁的 F 列  Key in 商品編號
在執行巨集後, 撈 D:\PIC 同檔名的照片到  G 列
請問我是那邊有執行上的錯誤嗎？
  1. Option Explicit
  2. Sub ChangeSize()
  3.     Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
  4.     Mypath = "D:\PIC\"
  5.     With Sheets("採購清單")
  6.         .Pictures.Delete
  7.         For i = 1 To 7 Step 3   'A欄 ->1,D欄 ->4,G欄 ->7
  8.             For Each E In .UsedRange.Columns(i).Cells  ' 'A欄 ->1,D欄 ->4,G欄 ->7
  9.                
  10.                 E.ColumnWidth = 25      '調整儲存格寬度
  11.                 E.RowHeight = 50        '調整儲存格高度
  12.                
  13.                 If Dir(Mypath & E & ".jpg") <> "" Then
  14.                     'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  15.                     With .Pictures.Insert(Mypath & E & ".jpg")
  16.                         .ShapeRange.LockAspectRatio = msoFalse
  17.                         .Left = E.Cells(1, 2).Left
  18.                         .Top = E.Cells(1, 2).Top
  19.                         .Width = E.Cells(1, 2).Width   '=儲存格寬度
  20.                         .Height = E.Cells(1, 2).Height '=儲存格高度
  21.                     End With
  22.                 End If
  23.             Next
  24.         Next
  25.     End With
  26. End Sub
複製代碼
作者: luhpro    時間: 2014-11-4 23:49

抱歉~~問個非常基本的問題

因為不熟 EXCEL 所以在貴討論區中像個無頭蒼蠅到處找我要的語法..
但是又不 ...
justinbaba 發表於 2014-11-3 17:30

UsedRange 此物件代表指定工作表中的已用範圍
所以當工作表中已有資料時,
並不一定是抓 A欄 ,D欄 ,G欄,
而是抓有資料區域中的第1欄,第4欄 與 第7欄.

該式可改為 :
For Each E In .Cells.Columns(i)  ' 'A欄 ->1,D欄 ->4,G欄 ->7
作者: justinbaba    時間: 2014-11-5 12:59

UsedRange 此物件代表指定工作表中的已用範圍
所以當工作表中已有資料時,
並不一定是抓 A欄 ,D欄 ,G欄, ...
luhpro 發表於 2014-11-4 23:49


謝謝大大回覆..

剛才試用了一下大大建議的程式碼..

出現了 "型態不符合" 的錯誤訊息耶...可否再指點一二呢？
  1. Option Explicit
  2. Sub ChangeSize()
  3.     Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
  4.     Mypath = "\C:\Users\leon\Desktop\Test\"
  5.     With Sheets("照片索引")
  6.         .Pictures.Delete
  7.         For i = 1 To 7 Step 3   'A欄 ->1,D欄 ->4,G欄 ->7
  8.             
  9.             For Each E In .Cells.Columns(i)  ' 'A欄 ->1,D欄 ->4,G欄 ->7
  10.                
  11.                 E.ColumnWidth = 25      '調整儲存格寬度
  12.                 E.RowHeight = 50        '調整儲存格高度
  13.                
  14.                 If Dir(Mypath & E & ".jpg") <> "" Then
  15.                     'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  16.                     With .Pictures.Insert(Mypath & E & ".jpg")
  17.                         .ShapeRange.LockAspectRatio = msoFalse
  18.                         .Left = E.Cells(1, 2).Left
  19.                         .Top = E.Cells(1, 2).Top
  20.                         .Width = E.Cells(1, 2).Width   '=儲存格寬度
  21.                         .Height = E.Cells(1, 2).Height '=儲存格高度
  22.                     End With
  23.                 End If
  24.             Next
  25.         Next
  26.     End With
  27. End Sub
複製代碼
作者: luhpro    時間: 2014-11-5 21:55

本帖最後由 luhpro 於 2014-11-5 22:10 編輯

回復 3# justinbaba
For Each E In .Cells.Columns(i)
實測發現 .Columns(i) 後面沒有加上 .Cells ,
會變成指定整欄而非單個儲存格,
所以會有錯誤.

不過這與我預期的結果不同,
使用Range變數透過 For Each 對整欄的元素做逐一處理,
解析後處理的元素卻還是整欄?
我有些納悶.

至於那行 Mypath = "\C:\Users\leon\Desktop\Test\" 怪怪的,
C: 前面不應該有 \ 出現.

觀察你的程式對整個工作表的每一列都有做高度設定,
這應該不是你想要的結果.
建議限制程式實際會作用到的範圍,
避免有非所預期甚至是多餘的動作拖長作業時間,
這個可用  .Cells(Rows.Count, l).End(xlUp).Row 方式來取得最底端有資料的列號.

還有對用於 列號 表示的變數,
建議不論實際上會使用到多大的列號,
都要 "養成習慣" 一律設為 Long 而非 Integer,
因為會有 溢位(超過可表示數字的最大值) 的風險.

最後這兩行 :
  E.ColumnWidth = 25      '調整儲存格寬度
  E.RowHeight = 50        '調整儲存格高度
設定的寬度是作用到存放圖檔名稱的儲存格,
而非放置圖片的儲存格,
我猜應非你想要的結果.
建議改為
  E.Cells(1, 2).ColumnWidth = 25      '調整儲存格寬度
  E.Cells(1, 2).RowHeight = 50        '調整儲存格高度

綜上所述建議程式修改如下
  1. Sub ChangeSize()
  2.     Dim Mypath As String, E As Range, l As Long, m As Long ', MyPic As Object
  3.     Mypath = "C:\Users\user12\Pictures\"
  4.     With Sheets("照片索引")
  5.         .Pictures.Delete
  6.         For l = 1 To 7 Step 3   'A欄 ->1,D欄 ->4,G欄 ->7
  7.             m = .Cells(Rows.Count, l).End(xlUp).Row
  8.             For Each E In Range(.Cells(1, l), .Cells(m, l)) ' 'A欄 ->1,D欄 ->4,G欄 ->7
  9.                 E.Cells(1, 2).ColumnWidth = 25      '調整儲存格寬度
  10.                 E.Cells(1, 2).RowHeight = 50        '調整儲存格高度
  11.                 If Dir(Mypath & E & ".jpg") <> "" Then
  12.                     'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
  13.                     With .Pictures.Insert(Mypath & E & ".jpg")
  14.                         .ShapeRange.LockAspectRatio = msoFalse
  15.                         .Left = E.Cells(1, 2).Left
  16.                         .Top = E.Cells(1, 2).Top
  17.                         .Width = E.Cells(1, 2).Width   '=儲存格寬度
  18.                         .Height = E.Cells(1, 2).Height '=儲存格高度
  19.                     End With
  20.                 End If
  21.             Next
  22.         Next
  23.     End With
  24. End Sub
複製代碼
作者: justinbaba    時間: 2014-11-6 17:39

回復  justinbaba
For Each E In .Cells.Columns(i)
實測發現 .Columns(i) 後面沒有加上 .Cells ,
會變 ...
luhpro 發表於 2014-11-5 21:55


謝謝luhpro兄 回覆 , 內容太深.. 我還得消化一下..  我試試後再回報狀況 ^ ^



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)