返回列表 上一主題 發帖

[發問] 自動開啟指定的檔案和標示底色。

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
1# 跳轉到 »
發表於 2019-8-26 15:47 | 顯示全部帖子
回復 1# ziv976688
大概是這樣吧~~
  1. Sub 自動填色_Click()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Dim databook As Workbook
  5.     Path = ThisWorkbook.Path '檔案路徑
  6.     Filename = Sheets(1).Range("A1").Value '指定名稱
  7.     Set databook = Workbooks.Open(Path & "\" & Filename) '開啟檔案
  8.     With databook.Sheets(1)
  9.         .Range("BA3:BF12").Interior.ColorIndex = 15
  10.         .Range("BA15:BF24").Interior.ColorIndex = 15
  11.         .Range("BA27:BF36").Interior.ColorIndex = 15
  12.         .Range("BA39:BF48").Interior.ColorIndex = 15
  13.         .Range("BA51:BF60").Interior.ColorIndex = 15
  14.         .Range("BA63:BF72").Interior.ColorIndex = 15
  15.         .Range("BA75:BF84").Interior.ColorIndex = 15
  16.     End With
  17.     With databook.Sheets(2)
  18.         .Range("BA3:BF12").Interior.ColorIndex = 15
  19.         .Range("BA15:BF24").Interior.ColorIndex = 15
  20.         .Range("BA27:BF36").Interior.ColorIndex = 15
  21.         .Range("BA39:BF48").Interior.ColorIndex = 15
  22.         .Range("BA51:BF60").Interior.ColorIndex = 15
  23.         .Range("BA63:BF72").Interior.ColorIndex = 15
  24.         .Range("BA75:BF84").Interior.ColorIndex = 15
  25.     End With
  26.     databook.Save  '儲存
  27.     databook.Close  '關閉
  28.     Application.ScreenUpdating = True
  29. End Sub
複製代碼

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
2#
發表於 2019-8-27 08:24 | 顯示全部帖子
回復 3# ziv976688
我只指定"A1"儲存格為檔名
因為我不知道你要從哪裡設定你要變更檔案的檔名

TOP

s13030029
　暱稱: 伊恩

中學生Rank: 2

帖子
97 
主題
33 
精華
0 
積分
129 
點名
0  
作業系統
Win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
註冊時間
2019-5-7 
最後登錄
2022-8-25 
3#
發表於 2019-8-27 09:10 | 顯示全部帖子
回復 3# ziv976688
加個迴圈吧
  1. Sub 自動填色_Click()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Dim databook As Workbook
  5.     Path = ThisWorkbook.Path '檔案路徑
  6.    
  7.     For i = 1 To Sheets(1).Range("A300").End(xlUp).Row
  8.     Filename = Cells(i, "A").Value '檔名
  9.     Set databook = Workbooks.Open(Path & "\" & Filename) '開啟檔案
  10.     With databook.Sheets(1)
  11.         .Range("BA3:BF12").Interior.ColorIndex = 15
  12.         .Range("BA15:BF24").Interior.ColorIndex = 15
  13.         .Range("BA27:BF36").Interior.ColorIndex = 15
  14.         .Range("BA39:BF48").Interior.ColorIndex = 15
  15.         .Range("BA51:BF60").Interior.ColorIndex = 15
  16.         .Range("BA63:BF72").Interior.ColorIndex = 15
  17.         .Range("BA75:BF84").Interior.ColorIndex = 15
  18.     End With
  19.     With databook.Sheets(2)
  20.         .Range("BA3:BF12").Interior.ColorIndex = 15
  21.         .Range("BA15:BF24").Interior.ColorIndex = 15
  22.         .Range("BA27:BF36").Interior.ColorIndex = 15
  23.         .Range("BA39:BF48").Interior.ColorIndex = 15
  24.         .Range("BA51:BF60").Interior.ColorIndex = 15
  25.         .Range("BA63:BF72").Interior.ColorIndex = 15
  26.         .Range("BA75:BF84").Interior.ColorIndex = 15
  27.     End With
  28.     databook.Save  '儲存
  29.     databook.Close  '關閉
  30.     Next
  31.    
  32.     Application.ScreenUpdating = True
  33. End Sub
複製代碼

TOP

        靜思自在 : 受人點水之恩，須當湧泉以報。
返回列表 上一主題