エクセルVBAでフォルダの作成

このQ&Aのポイント
  • エクセルVBAを使用して商品番号をダブルクリックすると専用のフォルダを作成する方法について教えてください。
  • フォルダ作成時には商品番号を名前にしたフォルダを作成し、そのフォルダへのハイパーリンクも設定したいです。
  • A列のどんな行でもダブルクリックすると専用フォルダ作成のメッセージが表示されるようにしたいです。
回答を見る
  • ベストアンサー

エクセルVBAでフォルダの作成

こんにちは。 セルA4から下に商品番号が書いてあります。 その商品番号をダブルクリックすると、「専用のフォルダをつくりますか?」とメッセージを出して、「はい」であれば、 (1)商品番号を名前にしたフォルダを作成 (2)その商品番号のフォルダへのハイパーリンクを設定 というようにしたいと思っています。 調べ、調べ下のように書いているのですか、 (1)、(2)の肝心の部分が分かりません。 あと、A列のどんな行でもダブルクリックするとメッセージが出るので、A4以降の商品番号のある行まで、というようにできればいいとも思っています。 お教えいただけないでしょうか。宜しくお願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Columns("A")) Is Nothing Then myMSG = "専用フォルダをつくりますか?" If MsgBox(myMSG, vbYesNo + vbQuestion, "フォルダ作成") = vbYes Then '以下に '(1)「倉庫」フォルダにクリックしたA列の商品番号を名前にしたフォルダ作成 '(2)つくったフォルダへのハイパーリンクを設定 End If End If End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

サンプルマクロです Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const path As String = "D:\TEMP\倉庫\" Dim wkStr As String  If Target.Column = 1 Then   wkStr = path & Target.Value   If Dir(wkStr, vbDirectory) = vbNullString Then    MsgBox wkStr & "フォルダがありません。作成します。"    MkDir wkStr   Else    MsgBox wkStr & "フォルダは存在します。"   End If   ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=wkStr  End If End Sub

4k3s4r3
質問者

お礼

zap35さん、こんにちは。 すごいですね、コードを見てなるほど、と分かる気がするのですが、 ここまでのデザインを自分ではできません。本当にありがとうこざいます。

関連するQ&A

  • エクセルVBAでフォルダの作成-2

    先ほどダブルクリックすると、クリックしたその名前にしたフォルダを作成して、ハイパーリンクを設定する、ということで質問させていただき、良い回答を頂き質問を閉じましたが、また質問があります。 A列をクリックするとイベントを発生させるのを、 A4セルから、その下のデータが入っているセルまで をイベントが有効な範囲にしたいと思い、考えています。 「If Target.Column = 1 Then」の部分がそれだと思い、 If Target.Range("A4", Range("A" & Rows.Count).End(xlUp)) Then のように考えて実行しましたが、これはダメでした。 このように限られた範囲に変更すにはどのようにすればいいでしょうか? Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const path As String = "D:\TEMP\倉庫\" Dim wkStr As String  If Target.Column = 1 Then   wkStr = path & Target.Value   If Dir(wkStr, vbDirectory) = vbNullString Then    MsgBox wkStr & "フォルダがありません。作成します。"    MkDir wkStr   Else    MsgBox wkStr & "フォルダは存在します。"   End If   ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=wkStr  End If End Sub

  • エクセル VBA について

    エクセルで、 ダブルクリックしたら"*"を表示したい範囲に【入力】という名前をつけ、 ダブルクリックしたら9つ左のセルの内容を表示したい範囲に【金額】という名前をつけ、 二つの構文?をVisual Basicに作成したんですが、エラーが出てしまいます。 ひとつずつだと上手くいくのですが、なぜでしょうか? わかる方教えてください。 あと申し訳ないのですが、VBAはまったくわからないため、ネット上で構文をコピーして貼り付けました。 そんな者でもわかる修正の説明をお願いいたします。 以下が作成し、エラーとなってしまう構文です。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const RangeName As String = "金額" If Target.Value = "" Then Target.Value = Target.Offset(0, -9).Value Cancel = True End If End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Const RangeName As String = "入力" If Not Intersect(Range(RangeName), Target) Is Nothing Then Cancel = True If Target = "*" Then Target = "" Else Target = "*" End If End If End Sub

  • どこが間違ってますか? (エクセルVBAです)

    質問をご覧くださりありがとうございます。 どなたか助けていただけないでしょうか。 以下のコードの場合、B2セルをダブルクリックすればシート(1)が開くと思っていたのですが、B2以外のセルをダブルクリックしてもシート(1)が開いてしまいます。 どこが悪いのでしょうか。 詳しい方がいらっしゃいましたら、どうか教えてください。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean) If Target = Range("B2") Then cancel = True Worksheets("シート(1)").Activate End If End Sub どうか、宜しくお願いいたします。

  • Excel VBAについて

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub Application.Goto Worksheets("人件費").Range("A1") Worksheets("人件費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub Application.Goto Worksheets("外注費").Range("A1") Worksheets("外注費").Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Target.Offset(, -5).Value cancel = True End Sub 上の指令はFの列をダブルクリックすると人件費のシートが開いてAある値を人件費の新しいセルのAに代入する指令ですが それをG列ダブルクリックで外注費シートに同じようにやろうと思いましたが出来ません。 たぶん根本的に書き方が間違っているのかと思われますが、ご指導のほどお願いします。

  • エクセルVBAのイベントで質問です。

    ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートA") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub

  • エクセルVBAで指定場所にフォルダー作成

    エクセルのVBAマクロ機能を使い、 自動フォルダー作成&リンクするマクロを作成したのですが、 現在のマクロですと「A(仮名)」の中にフォルダーに作ってしまいますので 下記の様に階層で指定出来る様にしたいのですが、教えて頂けないでしょうか? 出来れば、そのままマクロ貼り付けで使える様にしたいので、 下記に途中までのマクロを編集して頂ければ助かります。 「A(仮名)」と言うフォルダーの中にエクセルファイルの管理表を入れ 「A」のフォルダーの中に「B(仮名)」と言うフォルダーを作り、 その中に管理台帳で自動作成されるフォルダーがつくられる様にしたい。 現在のマクロ Sub MakeHyLink() Dim wkStr As String If ActiveCell.Column <> 1 Then Exit Sub If ActiveCell.Value = "" Then MsgBox "アクティブセルは未入力、やり直し" Exit Sub End If wkStr = ThisWorkbook.path & "\" & ActiveCell.Value If Dir(wkStr, vbDirectory) = "" Then MsgBox "フォルダー:" & wkStr & vbLf & " を、作成します。" MkDir wkStr Else MsgBox "フォルダー:" & wkStr & vbLf & " は、存在します。" End If ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=wkStr End Sub

  • エクセルにてダブルクッリクしたときの動作

    エクセルにて特定のセルをダブルクリックをした時に日付を表示させたくて以下のマクロを組みました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If intersect(Target, Range("A1")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Format(date, "yyyy") Cancel = True End If End Sub この場合A1セルをダブルクリックした時のみ西暦が入力されるようになっていますが、他のセルで、例えばB1セルでは月、C1セルでは日にちをダブルクリックで入力させるにはどうしたら良いでしょうか? If intersect(Target, Range("A1")) Is Nothing Then Exit Sub のTarget, Rangeを書き換えて複数このマクロを書き込んだのですがうまく動作しなくて。 知恵を貸していただけると助かります。

  • エクセル2007のVBAについて

    VBA初心者ですが、よろしくお願いします。 エクセルで入力したいシートタブを右クリック、コードの表示で、 VBAに以下のスクリプトを入力しました。 ネットに紹介されていたスクリプトに自分で一部書き足したものです。 U列に値が入っていれば、その行のT列をダブルクリックするとチェックマークがつくようにし、 それをU列の最終行までループしたいのですが、エラーなどはなくチェックマークが出現しません。 どこが間違っているのでしょうか?ご教授お願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) MaxRow = Range("U65536").End(xlUp).Row For i = 1 To MaxRow Step 1 If Range("U" & i) <> Null Then If Intersect(Target, Range("T" & i)) Is Nothing = False Then Cancel = True If Target.Value = ChrW(10003) Then Target.ClearContents Else Target.Value = ChrW(10003) End If End If End If Next i End Sub

  • エクセルVBA自動ハイパーリンクフォルダー指定場所

    管理台帳を作成したく、下記のVBAを作りました。 マクロ内容は、Aセルに管理番号を入力しマクロ実行ボタンにて、 入力した番号と同じフォルダーを作成しハイパーリンクする自動フォルダー作成&ハイパーリンクマクロです。 現在のフォルダー作成場所はローカルのDドライブ直下に作る様に指定しているのですが、 エクセルVBAがある場所と同じ場所に、上記のマクロで作るフォルダーが出来る様にしたいのですが、 見よう見まねでVBAを何とか作ったのですが、知識がなくこれ以上が解りません。 出来れば、下記のVBAを編集して頂、教えて頂いたVBAをそのままコピペすれば使える状態で教えて頂ければ助かります。 宜しくお願い致します。 Sub MakeHyLink() Const path As String = "D:\" Dim wkStr As String If ActiveCell.Column = 1 Then wkStr = path & ActiveCell.Value If Dir(wkStr, vbDirectory) = vbNullString Then MsgBox wkStr & "フォルダがありません。作成します。" MkDir wkStr Else MsgBox wkStr & "フォルダは存在します。" End If ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=wkStr End If

  • エクセルVBAで住所録を作成

    住所録シートに次のようにコードを作っています。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$B$1" Then 顧客名検索 ElseIf Target.Address = "$C$1" Then フリガナ検索 ElseIf Target.Address = "$D$1" Then 住所検索 ElseIf Target.Address = "$E$1" Then 郵便番号検索 ElseIf Target.Address = "$A$1" Then オートフィルタ解除 カナ順に設定 Else Exit Sub End If End Sub そして標準モジュールには Sub 顧客名検索() ans = InputBox("顧客名を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=2, Criteria1:="=*" & ans & "*" '2つ目のフィルターに検索文字 End With End Sub Sub フリガナ検索() ans = InputBox("顧客カナを入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=3, Criteria1:="=*" & ans & "*" '3つ目のフィルターに検索文字 End With End Sub Sub 住所検索() ans = InputBox("住所を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=4, Criteria1:="=*" & ans & "*" '4つ目のフィルターに検索文字 End With End Sub Sub 郵便番号検索() ans = InputBox("郵便番号を入力してください") With ActiveSheet If .AutoFilterMode Then 'オートフィルタモードがオンなら .AutoFilterMode = False 'リセットする End If .Range("A1:G1").AutoFilter 'オートフィルタモードをセット .Range("A1:G1").AutoFilter Field:=5, Criteria1:="=*" & ans & "*" '5つ目のフィルターに検索文字 End With End Sub Sub オートフィルタ解除() Application.CutCopyMode = False Selection.AutoFilter Range("A1").Select End Sub Sub カナ順に設定() Range("C1").Select ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Clear ActiveWorkbook.Worksheets("住所録").Sort.SortFields.Add Key:=Range("C1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("住所録").Sort .SetRange Range("A2:IV65536") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("A2").Select Selection.AutoFilter End Sub と入れています。 VISTAで作ったのですが、このファイルを共有にして使おうとすると、XPのパソコンでは、A1セルをダブルクリックすると、コードが黄色になり、マクロが中断されます。 B1~G1は問題なくマクロが実行されるのに・・・。 もう一台のVISTAでは同じ共有状態で使っても問題ありません。 どうすればXPでも問題なく使えるのでしょう?

専門家に質問してみよう