返回列表 上一主題 發帖

[發問] 指定儲存格文字轉大寫

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-4-6 00:12 | 只看該作者

[發問] 指定儲存格文字轉大寫

工作上常需要用到將英文字全部轉大寫或第一個字轉成大寫,我知道函數中可以做到,但不知使用巨集是否也能寫出這樣的效果?
我的需求如下,請高人指點!
a) 程式與需要轉大寫的文件是分開的
b) 分成二個按鈕全部轉大寫/第一個字轉成大寫(功能分開)
c) 在任一開啟的Excel文件的任何以滑鼠點選指定儲存格(單一或圈選的範圍例:a5/b10/c8:c12)
d)按下"轉換鈕"後,在指定儲存格將字體轉成大寫/第一個字大寫,當然未選定的儲存格不能轉換
e)因為開啟的可能是任何的文件,不知在寫程式的時候寫得出來嗎?
f)或者如果寫程式一定要指定檔名(我不清楚是否如此),就在檔案中指定一個檔名的位置(F1),不知是否可行?
upper.zip (11.41 KB)
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-4-6 08:51 | 只看該作者
回復 1# PJChen
兩按鍵 的共同程式碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim E As Range, Rng As Range
  4.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  5.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  6.     For Each E In Selection.SpecialCells(xlCellTypeConstants)
  7.         If InStr(Shapes(Application.Caller).OLEFormat.Object.Caption, "全部大寫") Then
  8.             E.Value = UCase(E)                          '全部轉換為大寫
  9.         Else
  10.             E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫
  11.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  12.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串
  13.         End If
  14.     Next
  15. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2012-4-6 11:38 | 只看該作者
回復 2# GBKEE
請問:
我將這個程式執行時,無論在原巨集檔案中或另一個測試"Test"檔中,都不能執行,請幫我看看問題出在哪?
另外這個程式
1) 二個按鈕功能分開(全部轉大寫/第一個字轉成大寫)是否能分開執行?(因為執行結果目前看不出來)
2) 可針對任何開啟的Excel文件執行 全部轉大寫/第一個字轉成大寫 功能嗎?
Upper.zip (22.32 KB)

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
4#
發表於 2012-4-6 13:44 | 只看該作者
引用G大大的寫法~ 自己改一改就好了~
  1. Sub uppera() '全部大寫
  2.     Dim E As Range, Rng As Range
  3.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  4.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  5.     For Each E In Selection.SpecialCells(xlCellTypeConstants)

  7.             E.Value = UCase(E)                          '全部轉換為大寫

  9.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  10.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串

  12.     Next
  13. End Sub
  14. Sub upperaf()  '第一個字大寫


  17.     Dim E As Range, Rng As Range
  18.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  19.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  20.     For Each E In Selection.SpecialCells(xlCellTypeConstants)

  22.             E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫
  23.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  24.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串

  26.     Next
  27. End Sub
複製代碼
回復 3# PJChen
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
5#
發表於 2012-4-6 14:14 | 只看該作者
回復 3# PJChen

再引用G大大的寫法~ 自己改一下~
程式設計前要先分析一下想要的結果是什麼~ 再怎麼來寫~
依您需要的東西~
按下任一個按鈕時~ 不管是開新檔或是執行該檔內的內容~ 就進行字的大寫調整
因此用一個IF 來判斷~ 是要執行該檔案還是執行新開的檔案
所以加了一個打開EXCEL的指令,判斷是不是要開檔案,
來完成最後的結果~
  1. Sub uppera() '全部大寫
  2. patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
  3. If patch = False Then
  4.     Dim E As Range, Rng As Range
  5.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  6.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  7.     For Each E In Selection.SpecialCells(xlCellTypeConstants)
  8.             E.Value = UCase(E)                          '全部轉換為大寫
  9.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  10.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串
  11.     Next
  12. Else
  13.     With Workbooks.Open(patch)
  14.         For Each E In .Sheets("工作表1").Range("A:C")
  15.           E.Value = UCase(E)
  16.         Next
  17.     End With
  18. End If

  20. End Sub
  21. Sub upperaf()  '第一個字大寫
  22. patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xls), *.xls")
  23. If patch = False Then
  24.     Dim E As Range, Rng As Range
  25.     If TypeName(Selection) <> "Range" Then Exit Sub '不是Range(儲存格)不往下執行程式
  26.     If Selection.Count = 1 And Selection(1) = "" Then Exit Sub  '選擇1儲存格且為空白時不往下執行程式
  27.     For Each E In Selection.SpecialCells(xlCellTypeConstants)
  28.             E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫                          '全部轉換為大寫
  29.             '**: Mid(E, 1, 1)-> 從第1個字元起讀入一個字元的字串
  30.             '**" Mid(E, 2) -> 從第2個字元起讀入全部的字串
  31.     Next
  32. Else
  33.     With Workbooks.Open(patch)
  34.         For Each E In .Sheets("工作表1").Range("A:C")
  35.           E.Value = UCase(Mid(E, 1, 1)) & LCase(Mid(E, 2))  '轉換第1個字元為大寫
  36.         Next
  37.     End With
  38. End If

  40. End Sub
複製代碼
學習才能提升自己

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2012-4-7 01:26 | 只看該作者
回復 5# hugh0620
您好,
您修改的第一篇可以轉換文字,但僅限於同一sheet中的文字.
第二篇我修了(*.xlsx),因為我想要二種檔案類型都可以用,但無論我改成 (*.xlsx), *.xls" 或  (*.xls), *.xlsx",當我按轉換鈕時並不會二種類型都出現,而且每次按轉換鈕excel就會當掉,
如果我一直不去理它,其實excel也不用重開,但它並不會轉換.
patch = Application.GetOpenFilename("Microsoft Excel 活頁簿 (*.xlsx), *.xls")

另外請教一個存檔問題,以下存為.xlsx時一切都沒有問題,但若存成.xls時,存檔時沒問題,但要打開存檔後的文件就會出現錯誤訊息,可否幫我看一下問題所在?
ActiveWorkbook.SaveAs "D:\" & [Q5] & " vs " & [C6] & "_PO#" & [V7] & "_" & [C16] & " booking to " & [C19] & ".xlsx"

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2012-4-7 09:56 | 只看該作者
回復 6# PJChen

你的問題我個人認為是因為你的巨集存放位置，與資料檔案是分開的檔案
由於2007版本以後，含有巨集的活頁簿，與一般活頁簿檔案格式不同，
所以，你在操作時被視為2個Application在執行(這是個人猜測，不一定正確)
要解決這種衝突，唯有將巨集存成增益集，然後加載增益集後，所有的活頁簿就可以共同使用該程式碼
將檔案解縮到系統預設增益集存放區
然後依照動畫加載使用試試

大小寫轉換.rar (10.62 KB)

    play.gif
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2012-4-7 12:16 | 只看該作者
回復 7# Hsieh

版大,
您的建議很不錯,但由於我從來沒有用過增益集的功能,完全不了解,您的操作有點快,我看不清楚,可能要自己研究一下.
我另一個存檔的問題不知是否有人可以解答?

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2012-4-7 12:46 | 只看該作者
回復 8# PJChen

概念相同，只是你要固定存檔位置，那麼增益集
   就沒有太大意義
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2012-4-7 14:20 | 只看該作者
回復 9# Hsieh
版大,
我問的另一個存檔問題,跟大小寫轉換是完全不相同的, 是我其它的巨集程式我摘錄下來的,
它存為.xlsx時一切都沒有問題,但若存成.xls時,存檔時沒問題,但要打開存檔後的文件就會出現錯誤訊息,因為我不知道問題所在?
出現的錯誤訊息就是前面所上傳的jpg圖片的訊息,想請教是否有人能為我解答.
ActiveWorkbook.SaveAs "D:\" & [Q5] & " vs " & [C6] & "_PO#" & [V7] & "_" & [C16] & " booking to " & [C19] & ".xlsx"

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
返回列表 上一主題