|
H26.06.12 現在
------------------ ここから ThisWorkBook コード -----------------------
ブックを閉じた時に、アドインを消去する。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Reset
B02リセット
End Sub
------------------------------------------------------------------
ブックを開いた時に、アドインを表示する。
Private Sub Workbook_Open()
Application.CommandBars("Cell").Controls(1).BeginGroup = True
B01セット
End Sub
------------------- ここから UForm20のコード ------------------------
[読込み先パス設定]ボタンクリックでブック読込先のディレクトリーを
設定する。
Private Sub CommandButton1_Click()
フォルダ参照 SFolda
If SFolda = "" Then Exit Sub <---- フォルダの指定が無い時は、
強制終了する。
読込側のフォルダのパス設定を「マクロの表紙」に保存する。
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value = SFolda
End Sub
------------------------------------------------------------------
[書込み先パス設定]ボタンクリックで写真書込み先のディレクトリーを
設定する。
Private Sub CommandButton2_Click()
フォルダ参照 SFolda
If SFolda = "" Then Exit Sub <---- フォルダの指定が無い時は、
強制終了する。
書込み先側のフォルダのパス設定を「マクロの表紙」に保存する。
Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value = SFolda
End Sub
------------------------------------------------------------------
[写真名抽出]ボタンクリックで指定されたのディレクトリーの写真ファイル名を
リストアップする。
Private Sub CommandButton3_Click()
ファイル名取得
End Sub
------------------------------------------------------------------
[開 始]ボタンクリックで指定された写真ファイルを読み込み、指定された
フォルダへ指定された
名前に変更して書き込むをする。
Private Sub CommandButton4_Click()
写真コピー変更
End Sub
------------------------------------------------------------------
[書き込み先の表示]ボタンクリックで写真読込先のディレクトリーを設定する。
Private Sub CommandButton5_Click()
' 書き込み先フォルダ表示
On Error GoTo ComB5ERR00: <---- エラー時のジャンプ先を設定
ADir = Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value
カレントフォルダを書き込み側のパスに移動する。
If ADir <> "" Then
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) <---- ネットワークドライブの参照
Else
ChDrive Left(ADir, 2) <---- PC内ドライブの参照
ChDir ADir
End If
End If
'Excel ファイルのみの時を表示したい時は、下記の様に記述します。
'Application.Dialogs(xlDialogOpen).Show
'
AAA = Workbooks(AAname).Worksheets(BBname).Cells(10, 1).Value
If AAA = "Excel" Or AAA = "" Then _
Excelブックを表示したいします。
BBB = Application.GetOpenFilename("Excelブック,*.xlsx"): Exit Sub
'
If AAA = Kakuchoshi_B Then _
指定された拡張子のファイルを表示します。
BBB = Application.GetOpenFilename(Kakuchoshi): Exit Sub
'
ComB5ERR00: <---- エラー処理をする。
N = Err.Number <---- エラー番号を取得する。
「エラー番号 76 ： パス名が見つからない」の時、メッセージを表示する。
If N = 76 Then _
MsgBox ("フォルダ " & UForm20.TextBox2.Text & "ありません。")
End Sub
------------------------------------------------------------------
[読込み先表示]ボタンクリックで写真読込先のディレクトリーを設定する。
Private Sub CommandButton6_Click()
' 読込み先フォルダ表示
On Error GoTo ComB6ERR00:
ADir = Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value
カレントフォルダを書き込み側のパスに移動する。
If ADir <> "" Then
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) <---- ネットワークドライブの参照
Else
ChDrive Left(ADir, 2) <---- PC内ドライブの参照
ChDir ADir
End If
End If
'Excel ファイルのみの時を表示したい時は、下記の様に記述します。
'Application.Dialogs(xlDialogOpen).Show
'
AAA = Workbooks(AAname).Worksheets(BBname).Cells(10, 1).Value
If AAA = "Excel" Or AAA = "" Then _
Excelブックを表示します。
BBB = Application.GetOpenFilename("Excelブック,*.xlsx"): Exit Sub
'
If AAA = Kakuchoshi_B Then _
指定された拡張子のファイルを表示します。
BBB = Application.GetOpenFilename(Kakuchoshi): Exit Sub
'
ComB6ERR00:
N = Err.Number
If N = 76 Then _
MsgBox ("フォルダ " & UForm20TextBox2.Text & "ありません。")
End Sub
------------------------------------------------------------------
[文字列置換]ボタンクリックで「文字書換」を実行する。
Private Sub CommandButton7_Click()
文字書換
End Sub
------------------------------------------------------------------
[オプションボタン1]が選らばれた時設定する。
Private Sub OptionButton1_Click()
CommandButton3 の表示文字を替える。
If UForm20.OptionButton1 = True Then _
UForm20.CommandButton3.Caption = "Excelファイル名抽出"
Excel/JPG の区分フラグに Excel を書込む。
Workbooks(AAname).Worksheets(BBname).Cells(10, 1).Value = "Excel"
End Sub
------------------------------------------------------------------
[オプションボタン2]が選らばれた時設定する。
Private Sub OptionButton2_Click()
CommandButton2 の表示文字を替える。
If UForm20.OptionButton2 = True Then _
UForm20.CommandButton3.Caption = Kakuchoshi_B & " 名抽出"
Excel/任意 の区分フラグに 指定拡張子名 を書込む。
Workbooks(AAname).Worksheets(BBname).Cells(10, 1).Value = _
Kakuchoshi_B
End Sub
------------------------------------------------------------------
Uform20のフームの初期値を設定する。
Private Sub UserForm_Initialize()
Excel/JPG の区分フラグを読込む。
AAA = Workbooks(AAname).Worksheets(BBname).Cells(10, 1).Value
If AAA = "Excel" Or AAA = "" Then
UForm20.OptionButton1 = True <---- [オプションボタン1]を
選択状態にする。
[オプションボタン1]を表示「Excelファイル抽出」にする。
UForm20.CommandButton3.Caption = "Excelファイル抽出"
Exit Sub
End If
If AAA = Kakuchoshi_B Then
UForm20.OptionButton2 = True <---- [オプションボタン2]を
選択状態にする。
[オプションボタン2]を表示「(指定拡張子名) 名抽出」にする。
UForm20.CommandButton3.Caption = Kakuchoshi_B & " 名抽出"
Exit Sub
End If
End Sub
------------------- ここから module1のコード ----------------------
マクロブック・シートの名前を定義、変数の宣言
Public N, N1, N2, Nmax, SS, SSS As Single
Public Const AAname As String = "コピー名前変更マクロ.xlsm"
Public Const BBname As String = "表紙"
Public AAA, BBB, CCC As String
Public Fname1, Fname2, Fname3, Sname, ADir, DirA, DirB As String
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_EDITBOX As Long = &H10
Public Kakuchoshi, Kakuchoshi_A As String
Public Kakuchoshi_B, Kakuchoshi_C As String
'----------------------------------------------------
' ネットワークドライブの参照
Public Declare Function SetCurrentDirectory _
Lib "kernel32" Alias "SetCurrentDirectoryA" _
(ByVal lpPathName As String) As Long
'----------------------------------------------------
------------------------------------------------------------------
アドインの表示処理
Sub B01セット()
Dim Mycontrol As CommandBarControl
Dim mysubmenu As CommandBarControl
'
Set Mycontrol = CommandBars("Worksheet Menu Bar"). _
Controls.Add(msoControlPopup)
Mycontrol.Caption = "【■】"
Mycontrol.OnAction = "Show表示"
End Sub
------------------------------------------------------------------
アドインの削除処理
Sub B02リセット()
CommandBars("Worksheet Menu Bar").Controls("【■】").Delete
End Sub
------------------------------------------------------------------
ユーザーフォームの表示処理
Sub Show表示()
AAA = Workbooks(AAname).Worksheets(BBname).Cells(3, 1).Value
' 大文字に変換する
BBB = AAA: BBB = StrConv(BBB, vbUpperCase)
' 小文字に変換する
CCC = AAA: CCC = StrConv(CCC, vbLowerCase)
' 例 "JPGファイル(*.jpg),*.jpg"
Kakuchoshi = AAA & "ファイル(*." & "),*." & CCC
Kakuchoshi_A = "*." & CCC ' 例 "*.jpg"
Kakuchoshi_B = BBB ' 例 "JPG"
Kakuchoshi_C = "." & CCC ' 例 ".jpg"
'
UForm20.Show vbModeless
End Sub---------------------------------------------------------------------------------
ダイヤログを表示し、参照したいフォルダのパス情報を取得するサブルーチン。
プログラムは、下記のとおりにして下さい。
また、参照設定で Microsoft shell Controls And Automationの設定を忘れないようして下さい。
設定の仕方が、分からない方は、このマクロをダウロードし、不要な箇所を削除して、流用して
ください。
[参照設定]のダイヤログの開き方
次の手順で、VBE(Visual Basic Editor)を開きます。
①[ツール] --> [マクロ] --> [マクロの表示] --> 適当なマクロを選び[編集] ---->
Visual Basicのダイヤログが開きます。
②[ツール] --> [参照設定] --> 必要とするライブラリィにチェックをいれて [OK]
Sub フォルダ参照(SFolda As Variant)
Dim myShell As Shell32.Shell
Dim myFolder As Shell32.Folder3
Dim myItem As Shell32.FolderItem
Set myShell = New Shell32.Shell
Set myFolder = myShell.BrowseForFolder( _
0&, "フォルダを選択してください。" _
, BIF_RETURNONLYFSDIRS Or BIF_EDITBOX)
If myFolder Is Nothing Then SFolda = "": Exit Sub
MsgBox myFolder.Self.Path
'
SFolda = myFolder.Self.Path
Set myFolder = Nothing
Set myShell = Nothing
End Sub
-------------------------------------------------------------------
コピーする任意の拡張子のファイル名を取得するサブルーチン
Sub ファイル名取得_JPG()
Dim myPath, myFname, Bname, Sname, AA As Variant
Dim NN, MM, ZZ As Single
'
On Error GoTo ファイル名取得ERR00: <-- エラー時のジャンプ先を設定
「マクロの表紙」のリストアップするエリヤを消去する。
' セルの内容を消去する
N = ActiveSheet.Cells(1, 16).Value <--- 書込みデータの数+1を取得
If N > 2 Then <--- 書込みがある時のみ消去
C_Range = "O1:Q" & CStr(N) <--- 消去範囲をレンジデータを作成
Range(C_Range).Select <--- 消去範囲を選択する
Selection.ClearContents <-- 写真のファイル名を書き込むエリヤを消去
End If
' 写真枚数カウント関数書込み
ActiveSheet.Cells(1, 16).Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C:R[10000]C)+1"
Range("O1").Select
「マクロの表紙」のリストアップするエリヤにタイトル文字を書き込む。
Cells(2, 15).Value = "番号" '
Cells(2, 16).Value = "変更前名前"
Cells(2, 17).Value = "変更後名前"
ZZ = 3: MM = 1 <---- 初期値を設定する。
MM : 番号 ZZ : 書込みセル位置
'----------------------------------------------------
カレントフォルダを読込側のパスに移動する。
ADir = Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value
If ADir <> "" Then
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) <--- ネットワークドライブの参照
Else
ChDrive Left(ADir, 2) <--- PC内ドライブの参照
ChDir ADir
End If
End If
読込側のフォルダの写真のファイル一覧を表示する。
myFname = Application.GetOpenFilename(Kakuchoshi)
If myFname = False Then Exit Sub <--- ファイルがクリックされ
' ない時、強制終了する。
'------------------------------------------------------------------
' 次読込の為のパスを記録する。
C_cnt = Len(myFname) <--- 選択した写真のフルパス文字数
F_array = Split(myFname, "\") <--- Split関数で \ で分割して 配列
F_array に代入
A_cnt = UBound(F_array) <--- 現在の大きさ(要素数)を調べます
CCC = F_array(A_cnt) <--- 最後配列に写真名がある
L_cnt = Len(CCC) + 1 <--- 写真名の文字数 + \ の分
' フォルダのフルパスデータを記録する。
Workbooks(AAname).Worksheets(CCname).Cells(1, 1).Value = _
Left(myFname, C_cnt - L_cnt)
'------------------------------------------------------------------
'
フォルダへのパスデータに \ を付ける。
myPath = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value & "\"
フォルダへのフルパスデータを作成する。
myFname = Dir(myPath & Kakuchoshi_C) ' ファイル名取得
フォルダ内のjpgファイルをすべてリストアップする。
Do While myFname <> ""
'
Cells(ZZ, 15).Value = MM ' 番号
Cells(ZZ, 16).Value = myFname ' ファイル名設定
'
ZZ = ZZ + 1: MM = MM + 1
myFname = Dir() ' ファイル名が無くなるまで実行
Loop
'
Exit Sub
ファイル名取得ERR00: <---- エラー処理をする。
N = Err.Number <---- エラー番号を取得する。
「エラー番号 76 ： パス名が見つからない」の時、メッセージを表示する。
If N = 76 Then MsgBox ("フォルダ " & CCC & "ありませんので、
作成して下さい。OKをクリックして下さい。"): Exit Sub
エラー番号 76 以外の時、メッセージを表示する。
MsgBox ("設定等に間違いがあります。")
End Sub
------------------------------------------------------------------------
指定された任意の拡張子ファイルを読み込み、指定されたフォルダへ
指定された名前に変更して書き込むサブルーチン
Sub 写真コピー変更_JPG()
'----------------------------------------------------
' このマクロは、Windows Script Host Object Model を使用して
' いるので、マクロ-ツール-参照設定で上記のオブジェクトに
' チェックを入れて、使用すること。
'----------------------------------------------------
On Error GoTo FcopyERR00: <--- エラー時のジャンプ先を設定
リストデータの終了セル位置を取得する。
SS = ActiveSheet.Range("O1000").End(xlUp).Row
SSS = 2 <--- リストデータの初期位置
'
写真コピー10:
コピーするファイル名を「マクロの表紙」から取得する。
CCC = _
Workbooks(AAname).Worksheets(BBname).Cells(SSS, 17).Value
書込み先のフォルダパスを「マクロの表紙」から取得する。
ADir = _
Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value
If ADir = "" Then Exit Sub <--- 書き込み先の設定が無い時は、
BBB = ADir 強制終了する
書込み先のフォルダパスを作成する。
Fname2 = BBB & "\"
'----------------------------------------------------
' 同一のファイル名がないかチェック
'----------------------------------------------------
Fname2 = ( 書込み先のフォルダのパス )
CCC = ( コピーするファイル名 )です。
Fname3 = ( 書込み先のファイルのフルパス )です。
Fname3 = Fname2 & CCC & Kakuchoshi_C
With New IWshRuntimeLibrary.FileSystemObject
Fname2=( 書込み先のフォルダのパス )
BBB=( 読込先のフォルダのパス )です。
書込み先のフォルダが有るかチェックする。
If Not .FolderExists(Fname2) Then
書き込み先フォルダがない時メッセージを表示する。
MsgBox "コピー先のフォルダ" & BBB & "が見つかりません。", _
vbExclamation
GoTo 写真コピー10B:
End If
書き込み先に同一のファイル名がないかチェックする。
If Not .FileExists(Fname3) Then
a = a <--- デバック時のブレークポイントを設定する位置。
Else
書き込み先に同一のファイル名がある時メッセージを表示する。
MsgBox "同一ファィル「 " & CCC & " 」があります。", vbExclamation
GoTo 写真コピー10B:
End If
'
End With
'----------------------------------------------------
' 読込側のパス設定 写真名
'----------------------------------------------------
読込むファイル名を「マクロの表紙」から取得する。
Sname = _
Workbooks(AAname).Worksheets(BBname).Cells(SSS, 16).Value
読込むファイルのフルパスを作成する。
Fname1 = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value _
& "\" & Sname
'
'----------------------------------------------------
' 指定フォルダへ、書き込む
'----------------------------------------------------
Fname1のフルパスのファイルをFname2で示すフォルダにコピーする。
With New IWshRuntimeLibrary.FileSystemObject
.CopyFile Fname1, Fname2, True
End With
'
'----------------------------------------------------
' 名前変更
'----------------------------------------------------
' 書込み側のパス設定
カレントフォルダを書込み側のパスに移動する。
ADir = _
Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value
If ADir <> "" Then
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) <---- ネットワーク
Else ドライブの参照
ChDrive Left(ADir, 2) <--- PC内ドライブの参照
ChDir ADir
End If
End If
Sname=( 変更前のファイル名 ) CCC=( 変更後のファイル名 )です。
DirA = Sname: DirB = CCC & Kakuchoshi_C
Name DirA As DirB <--- ファイル名を DirA から DirB へ変更
すべて終了したか判定する。
If SSS < SS Then SSS = SSS + 1: GoTo 写真コピー10:
'
MsgBox ("写真コピー名前変更完了") <--- 完了メッセージ。
'Unload UForm20 <--- を取れば完了と同時に表示フォームが
' 消去します。
写真コピー10B:
Exit Sub
FcopyERR00: <---- エラー処理をする
N = Err.Number <---- エラー番号を取得する
「エラー番号 76 ： パス名が見つからない」の時、メッセージを表示する
If N = 76 Then MsgBox ("フォルダ " & CCC & "ありません。")
「エラー番号 75 ： パス名無効です」の時、メッセージを表示する
If N = 75 Then MsgBox ("フォルダ " & CCC & "作成済です。")
End Sub
-----------------------------------------------------------------------
Sub ファイル名取得_JPG()と内容は、同じなので説明は省略します。
Sub ファイル名取得_Excel()
'
On Error GoTo ファイル名取得_ExcelERR00:
Bname = ActiveWorkbook.Name ' ブック名取得
Sname = ActiveSheet.Name ' シート名取得
'
N = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 16).Value
If N > 2 Then
E_Range = "O1:Q" & CStr(N)
Range(E_Range).Select
Selection.ClearContents ' 消去
End If
Cells(2, 15).Value = "番号"
Cells(2, 16).Value = "変更前名前"
Cells(2, 17).Value = "変更後名前"
ActiveSheet.Cells(1, 16).Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C:R[10000]C)+1"
ZZ = 3: MM = 1
'----------------------------------------------------
' カレントパス変更
ADir = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value
If ADir <> "" Then
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) ' ネットワークドライブの参照
Else
ChDrive Left(ADir, 2) ' PC内ドライブの参照
ChDir ADir
End If
End If
'
myFname = _
Application.GetOpenFilename("写真ファイル(*.xlsx),*.xlsx")
'
If myFname = False Then Exit Sub ' 強制終了
'----------------------------------------------------
Filename$ = Dir(myFname, vbNormal)
Sname = Filename$ ' ファイル名
'----------------------------------------------------
' 次読込の為のパスを記録する。
' 選択した写真のフルパス文字数
C_cnt = Len(myFname)
' \ で分割して 配列 F_array に代入
F_array = Split(myFname, "\")
' 現在の大きさ(要素数)を調べます
A_cnt = UBound(F_array)
' 最後配列に写真名がある
CCC = F_array(A_cnt)
' 写真名の文字数 + \ の分
L_cnt = Len(CCC) + 1
' 読込側のパス設定( \写真名 分を取る処理 )
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value = _
Left(myFname, C_cnt - L_cnt)
'------------------------------------------------------------------
' ドライブ名・フォルダ名取得
myPath = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value & "\"
myFname = Dir(myPath & "*.xlsx") ' ファイル名取得
'
Do While myFname <> ""
'
Cells(ZZ, 15).Value = MM ' 番号
Cells(ZZ, 16).Value = myFname ' ファイル名設定
'
ZZ = ZZ + 1: MM = MM + 1
myFname = Dir() ' ファイル名が無くなるまで実行
Loop
'
Exit Sub
ファイル名取得_ExcelERR00:
N = Err.Number
If N = 76 Then MsgBox ("フォルダ " & CCC & "ありませんので、
作成して下さい。OKをクリックして下さい。"): Exit Sub
MsgBox ("設定等に間違いがあります。")
End Sub
------------------------------------------------------------------------
Sub 写真コピー変更_JPG()と内容は、同じなので説明は省略します。
Sub コピー変更_Excel()
'----------------------------------------------------
' このマクロは、Windows Script Host Object Model を使用して
' いるので、マクロ-ツール-参照設定で上記のオブジェクトに
' チェックを入れて、使用すること。
'----------------------------------------------------
On Error GoTo コピー変更_ExcelERR00:
'
With ActiveWindow.RangeSelection
SSS = .Rows.Row ' 縦位置 start
SS = .Rows(.Rows.Count).Row ' 縦位置 end
End With
'
コピー変更_Excel10:
'
CCC = _
Workbooks(AAname).Worksheets(BBname).Cells(SSS, 17).Value
' 書込み先のフォルダパス
ADir = Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value
If ADir = "" Then Exit Sub
BBB = ADir
' 貼付け先サブフォルダのパス
Fname2 = BBB & "\"
'----------------------------------------------------
' 同一のファイル名がないかチェック
'----------------------------------------------------
Fname3 = Fname2 & CCC & ".xlsx"
With New IWshRuntimeLibrary.FileSystemObject
'
If Not .FolderExists(Fname2) Then
MsgBox "コピー先のフォルダ" & BBB & "が見つかりません。", _
vbExclamation
GoTo コピー変更_Excel10B:
End If
'
If Not .FileExists(Fname3) Then
a = a
Else
MsgBox "同一ファィル「 " & CCC & " 」があります。", _
vbExclamation
GoTo コピー変更_Excel10B:
End If
'
End With
'----------------------------------------------------
' 読込側のパス設定 写真名
'----------------------------------------------------
'
Sname = _
Workbooks(AAname).Worksheets(BBname).Cells(SSS, 16).Value
Fname1 = _
Workbooks(AAname).Worksheets(BBname).Cells(1, 1).Value _
& "\" & Sname
'
'----------------------------------------------------
' 指定フォルダへ、書き込む
'----------------------------------------------------
With New IWshRuntimeLibrary.FileSystemObject
.CopyFile Fname1, Fname2, True
End With
'
'----------------------------------------------------
' 名前変更
'----------------------------------------------------
' 書込み側のカレントパス変更
'
ADir = Workbooks(AAname).Worksheets(BBname).Cells(2, 1).Value
If ADir <> "" Then
' H25.06.09 追加
If Left(ADir, 2) = "\\" Then
Call SetCurrentDirectory(ADir) ' ネットワークドライブの参照
Else
ChDrive Left(ADir, 2) ' PC内ドライブの参照
ChDir ADir
End If
End If
DirA = Sname: DirB = CCC & ".xlsx"
Name DirA As DirB
'
If SSS < SS Then SSS = SSS + 1: GoTo コピー変更_Excel10:
'
MsgBox ("写真コピー名前変更完了")
'Unload UForm20
'
コピー変更_Excel10B:
Exit Sub
コピー変更_ExcelERR00:
N = Err.Number
If N = 76 Then MsgBox ("フォルダ " & CCC & "ありません。")
If N = 75 Then MsgBox ("フォルダ " & CCC & "作成済です。")
End Sub
------------------------------------------------------------------------
ドラックしたセル内の文字列から、マクロ表紙のセル(2,9)(2,10)で
指定された文字に置換する。
Sub 文字書換()
' 任意文字削除
AAA = Workbooks(AAname).Worksheets(BBname).Cells(2, 9).Value
BBB = Workbooks(AAname).Worksheets(BBname).Cells(2, 10).Value
AAA・BBBの両方にデータが無いときは、強制終了させる。
If AAA = "" Or BBB = "" Then Exit Sub
変数AAAで指定された文字を変数BBBで指定された文字に置換する。
Selection.Replace What:=AAA, Replacement:=BBB, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Sub
------------------------------------------------------------------------
|
|