| |
>Jaka さん
ご指摘ありがとうございます。
抜けだらけのコードですいませんでしたm(__)m
修正しましたので、再度投稿いたします。
Sub Sample1()
Dim objFileSys As Scripting.FileSystemObject
Dim objFileSrch As FileSearch
Dim objExcelAppl As Excel.Application
Dim objExcelWBooks As Excel.Workbooks
Dim objExcelWBook As Excel.Workbook
Dim objSheet As Worksheet '処理対象ワークシート
Set objFileSys = CreateObject("Scripting.FileSystemObject")
Set objFileSrch = Application.FileSearch
Set objExcelAppl = CreateObject("Excel.Application")
Set objExcelWBooks = objExcelAppl.Workbooks
Set objExcelWBook = objExcelWBooks.Open(Filename:="C:\QuestionBox.xls")
Set objSheet = objExcelWBook.Worksheets(1)
'*****サンプルデータ作成*****
Sample2 objSheet
objExcelWBook.Save
'*****半角カナ→全角カナ変換*****
objExcelAppl.Visible = True '処理対象ファイルを表示
Sample3 objSheet
Set objSheet = Nothing
objExcelWBook.Save
objExcelWBook.Close
objExcelAppl.Quit
Set objExcelWBooks = Nothing
Set objExcelAppl = Nothing
Set objFileSys = Nothing
Set objFileSrch = Nothing
MsgBox "処理完了です"
End Sub
Sub Sample2(ByRef objSheet As Worksheet)
objSheet.Range("A1").Value = "12ｱｲｳｴｵ34"
objSheet.Range("A2").Value = "56カキクケコ78"
objSheet.Range(objSheet.Range("A1"), objSheet.Range("A2")).Copy
objSheet.Range(objSheet.Range("A1"), objSheet.Cells(1500, 200)).PasteSpecial xlPasteValues
End Sub
Sub Sample3(ByRef objSheet As Worksheet)
Dim lngCode As Long 'ループカウンタ
Dim rngUsdRange As Range '処理範囲
Dim strHankaku As String '半角カナ
Dim strZenkaku As String '全角カナ
Set rngUsdRange = objSheet.UsedRange
For lngCode = 166 To 221
strHankaku = Chr$(lngCode) '半角カナ
strZenkaku = StrConv(strHankaku, vbWide) '全角カナ
'半角カナ→全角カナ変換
rngUsdRange.Replace what:=strHankaku, Replacement:=strZenkaku, _
MatchCase:=False, Matchbyte:=True
Next lngCode
End Sub
上記は、Cドライブ直下に「QuestionBox.xls」というファイル名の
空のExcelファイルを用意していただいてから、
Sample1を実行していただければ動きます。
QuestionBox.xlsにサンプルデータを記入(Sample2)して、
それに対して処理(Sample3)を行います。
QuestionBox.xlsを表示しないで処理するには、Sample1内の
objExcelAppl.Visible = True
をコメントアウトしていただければOKです。
すごい面倒かとは思いますが、
お時間があるときにご検討いただければ嬉しいです。
よろしくお願いしますm(__)m
|
|
なば
- 06/11/15(水) 15:50 -
