エクセル小僧：別のエクセルファイルから文字列をコピーするマクロ【コード編2】
別のエクセルファイル（以下、ワークブックと呼ぶ）から、文字列を
コピーしてくるマクロのファイル名ボタンのマクロのコードを示します。ワークシート側の設定については、
http://blog.so-net.ne.jp/cheese999/2012-12-23/trackback
を参照して下さい。
【コード：ファイル名ボタン】
ファイル名ボタンから呼ばれるマクロは、『USOpFileNm1_1』です。
類似コードとしては、
http://blog.so-net.ne.jp/cheese999/2012-09-24
が、あたります。
01:Sub USOpFileNm1(myRange As Variant, myType As Integer)
02: ' 機能:『ファイルを開く』ダイアログを開き、引数で指定されたセルにファイル名を代入
03: ' 【引数】
04: ' myRange : ファイル名を代入するセルのRange
05: ' myType : ファイルの種類
06: ' 【変数】
07: Dim FileName1 As Variant ' ファイル名
08: Dim myFFilter As String ' ファイルフィルタ
09: ' ファイルフィルタを選ぶ
10: Select Case myType
11: Case 0 ' テキスト
12: myFFilter = "テキストファイル(*.txt),*.txt,"
13: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
14: Case 1 ' 実行ファイル
15: myFFilter = "実行ファイル(*.exe),*.exe,"
16: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
17: Case 2 ' エクセルファイル
18: myFFilter = "Excelマクロ有効ブック(*.xlsm),*.xlsm,"
19: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
20: Case Else
21: myFFilter = "全てのファイル(*.*),*.*"
22: End Select
23: 'ファイルを開くダイアログを開く
24: FileName1 = Application.GetOpenFilename( _
25: FileFilter:=myFFilter _
26: , FilterIndex:=1 _
27: , Title:="開けゴマ(" & myRange & ")" _
28: , MultiSelect:=False _
29: )
30: 'キャンセルされなかったら、ファイル名を代入
31: If FileName1 <> False Then
32: Range(myRange).Value = FileName1
33: End If
34:End Sub
01:Sub USOpFileNm1_1()
02: ' 【機能】「ファイルを開く」ダイアログを開き、Range("file1")のセルにファイル名を代入
03: ' 【変数】
04: Dim Ans1 As Integer ' 答え
05: Dim myRange1 As Variant ' セル範囲(Range)
06: Dim myRange2 As Variant ' IP addressのセル範囲(Range)
07: Dim myR2 As Variant ' Range要素の繰り返し用
08: Dim i As Integer ' 整数
09: ' myRange1(0) : コピー元のエクセルファイル名のRange
10: ' myRange1(1) : コピー元のエクセルファイルのシート名のRange
11: ' myRange1(2) : コピー元のセル名のRange
12: ' myRange1(3) : ファイルパスの形式のRange
13: ' myRange1(4) : コピー先のシート名のRange
14: ' 【コード】
15: myRange1 = Array("file1", "sheet1", "cell1", "TypeFilePath", "sheet2")
16: Ans1 = MsgBox("""ファイルを開く""から選ぶ：Yes" & vbCrLf & _
17: "デフォルトに戻す:No", vbYesNoCancel + vbDefaultButton3)
18: Select Case Ans1
19: Case vbYes ' 『ファイルを開く』から選ぶ
20: Call USOpFileNm1(myRange1(0), 2)
21: Range(myRange1(3)).Value = "フルパス"
22: Case vbNo ' デフォルトに戻す
23: Range(myRange1(0)).Value = "Book1.xlsm"
24: Range(myRange1(1)).Value = "元data"
25: Range(myRange1(2)).Value = "IP_Add1,IP_Add2,IP_Add3"
26: Range(myRange1(3)).Value = "ファイル名"
27: Range(myRange1(4)).Value = "data"
28: ' IP addressをクリア
29: myCell1 = Split(Range(myRange1(2)).Value, ",")
30: For i = 0 To UBound(myCell1)
31: Set myRange2 = Range(myCell1(i))
32: For Each myR2 In myRange2
33: myR2.Value = ""
34: Next myR2
35: Next i
36: Case vbCancel
37: ' 何もしない
38: Case Else
39: ' 何もしない
40: End Select
41:End Sub
The Bangles --- Eternal Flame
キリストから教わったのは、自己犠牲でしょうか？
チョーヤ 酔わないウメッシュ cm 北乃きい
The Red Hot Chili Peppers - Snow (Hey Oh) Album Version
レッチリ サイコー！
コピーしてくるマクロのファイル名ボタンのマクロのコードを示します。ワークシート側の設定については、
http://blog.so-net.ne.jp/cheese999/2012-12-23/trackback
を参照して下さい。
【コード：ファイル名ボタン】
ファイル名ボタンから呼ばれるマクロは、『USOpFileNm1_1』です。
類似コードとしては、
http://blog.so-net.ne.jp/cheese999/2012-09-24
が、あたります。
01:Sub USOpFileNm1(myRange As Variant, myType As Integer)
02: ' 機能:『ファイルを開く』ダイアログを開き、引数で指定されたセルにファイル名を代入
03: ' 【引数】
04: ' myRange : ファイル名を代入するセルのRange
05: ' myType : ファイルの種類
06: ' 【変数】
07: Dim FileName1 As Variant ' ファイル名
08: Dim myFFilter As String ' ファイルフィルタ
09: ' ファイルフィルタを選ぶ
10: Select Case myType
11: Case 0 ' テキスト
12: myFFilter = "テキストファイル(*.txt),*.txt,"
13: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
14: Case 1 ' 実行ファイル
15: myFFilter = "実行ファイル(*.exe),*.exe,"
16: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
17: Case 2 ' エクセルファイル
18: myFFilter = "Excelマクロ有効ブック(*.xlsm),*.xlsm,"
19: myFFilter = myFFilter + "全てのファイル(*.*),*.*"
20: Case Else
21: myFFilter = "全てのファイル(*.*),*.*"
22: End Select
23: 'ファイルを開くダイアログを開く
24: FileName1 = Application.GetOpenFilename( _
25: FileFilter:=myFFilter _
26: , FilterIndex:=1 _
27: , Title:="開けゴマ(" & myRange & ")" _
28: , MultiSelect:=False _
29: )
30: 'キャンセルされなかったら、ファイル名を代入
31: If FileName1 <> False Then
32: Range(myRange).Value = FileName1
33: End If
34:End Sub
01:Sub USOpFileNm1_1()
02: ' 【機能】「ファイルを開く」ダイアログを開き、Range("file1")のセルにファイル名を代入
03: ' 【変数】
04: Dim Ans1 As Integer ' 答え
05: Dim myRange1 As Variant ' セル範囲(Range)
06: Dim myRange2 As Variant ' IP addressのセル範囲(Range)
07: Dim myR2 As Variant ' Range要素の繰り返し用
08: Dim i As Integer ' 整数
09: ' myRange1(0) : コピー元のエクセルファイル名のRange
10: ' myRange1(1) : コピー元のエクセルファイルのシート名のRange
11: ' myRange1(2) : コピー元のセル名のRange
12: ' myRange1(3) : ファイルパスの形式のRange
13: ' myRange1(4) : コピー先のシート名のRange
14: ' 【コード】
15: myRange1 = Array("file1", "sheet1", "cell1", "TypeFilePath", "sheet2")
16: Ans1 = MsgBox("""ファイルを開く""から選ぶ：Yes" & vbCrLf & _
17: "デフォルトに戻す:No", vbYesNoCancel + vbDefaultButton3)
18: Select Case Ans1
19: Case vbYes ' 『ファイルを開く』から選ぶ
20: Call USOpFileNm1(myRange1(0), 2)
21: Range(myRange1(3)).Value = "フルパス"
22: Case vbNo ' デフォルトに戻す
23: Range(myRange1(0)).Value = "Book1.xlsm"
24: Range(myRange1(1)).Value = "元data"
25: Range(myRange1(2)).Value = "IP_Add1,IP_Add2,IP_Add3"
26: Range(myRange1(3)).Value = "ファイル名"
27: Range(myRange1(4)).Value = "data"
28: ' IP addressをクリア
29: myCell1 = Split(Range(myRange1(2)).Value, ",")
30: For i = 0 To UBound(myCell1)
31: Set myRange2 = Range(myCell1(i))
32: For Each myR2 In myRange2
33: myR2.Value = ""
34: Next myR2
35: Next i
36: Case vbCancel
37: ' 何もしない
38: Case Else
39: ' 何もしない
40: End Select
41:End Sub
The Bangles --- Eternal Flame
キリストから教わったのは、自己犠牲でしょうか？
チョーヤ 酔わないウメッシュ cm 北乃きい
The Red Hot Chili Peppers - Snow (Hey Oh) Album Version
レッチリ サイコー！
nice! arigatouございます。
(^_0)ノ
by cheese999 (2012-12-26 23:18)
Application.GetOpenFilename()の戻り値がFalseでなかった場合の処理の説明を追加しました。
Sub USOpFileNm1()の３０行目です。
(^_0)ノ
by cheese999 (2012-12-29 06:31)