いつもお世話になってます。
工場の現場のタブレットPCから
NASの中にある図面(PDF)を見つけ出して
タブレットの画面に表示するというマクロを使っております。
※ユーザーフォームの画面、コードは最下段の通りです
このマクロは、こちらのサイトで頂いた、
マクロに対して、私がユーザーフォームを作成し、
ボタンを割り当てただけのものです。
作成時にアドバイスして下さった、
みなさんありがとうございました。
↓
http://bit.ly/2awqTb2
http://bit.ly/29gdmC4
このマクロを使っていたのですが、
最近になって問題が出てきました。
それは図面の改正です。
図面の改正にはルールがあり、
改正された時には末尾(一番右)にA~Z(半角大文字)が
付与されます。
要するに、以下のような感じになります。
1A000123 図番(初版)
↓改正
1A000123A 図番+A(改正コード)
というようになります。
今まではユーザーフォームのボタンにある通り、
配布された図番だけで見つからなかった場合、
図番に対して改正コードの「A」、「B」を付与して
再度検索すれば大抵の場合、見つかりました。
ところが最近になって、
配布した時は初版(改正コードなし)なのに、
現場が使うより早く「C」以降の改正コードがついたり、
既に改正がかかった状態で配布された図面番号「2A000123A」が
「2A000123G」になったりするようなケースが増えました。
そのため、現場の作業者が以下のMacro1で検索しても見つからなくなり、
以下の2点について対応しなけらばならなくなりました。
-------
A)図番(初版)に対してA~Zまでの改正コードを付与して再検索する
B)図番+改正コードの図面番号に対して、改正コードをB~Zに変更し
再度検索する
-------
ということが必要になりました。
すいませんが詳しい方、説明の上手な方、直接、コードで説明できる方、
お手数ですがA)、B)について教えて下さい。よろしくお願いします。
注意
1)便宜上、ファイルはCドライブの「A」フォルダーに
入っていることにしてます。コードを書く時はこれでお願いします。
※フルパスは「C:\A」です。
※NASへのパスはこちらで書き換えます。
2)画像のユーザーフォーム上の数字はボタンの番号です
3)一番上のテキストボックスに図面番号をバーコードリーダーで入力しています。
※手入力も可能です
※下のテキストボックスはフルパスを表示しています。管理上便利なので表示しています。
追記
余裕があればコードを書く時に以下の1)、2)のことを
考慮して書いて頂けるとありがたいです。
※余裕がなければ書きやすいように書いて頂いて大丈夫です。
1)変数を使う時は変数を宣言しない
2)変数の名前は日本語(漢字かひらかな)で名前をつける
↓
VBA初心者です。頂いたコードをカスタマイズする時に便利ですので
1)、2)について配慮して頂けるとありがたいです。
不可なら書きやすいように書いて頂いてOKです
3)以下のMacro1が現状のマクロです。
今のこちらの実力を知って頂くために記載しました。
こちらをカスタマイズしてもいいし、全部自分で作ったものでもOKです。
※エラー対策=ファイルがないときのメッセージ表示はつけて下さい
すいませんがよろしくお願いします。
------標準モジュール-------------
Sub Macro1()
UserForm1.Show vbModeless
End Sub
------ユーザーフォーム-------------
Private Sub CommandButton1_Click()
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & ".pdf"
End Sub
Private Sub CommandButton2_Click()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox1.SetFocus
End Sub
Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
If Dir(FName, vbNormal) = "" Then
MsgBox "ファイルが見つかりません。", vbExclamation
Else
WSH.Run """" & FName & """", 3
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With
End If
Set WSH = Nothing
End Sub
Private Sub CommandButton4_Click()
TextBox2.Value = ""
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & "A" & ".pdf"
End Sub
Private Sub CommandButton5_Click()
TextBox2.Value = ""
End Sub
Private Sub CommandButton6_Click()
TextBox2.Value = ""
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & "B" & ".pdf"
End Sub
No.3ベストアンサー
- 回答日時:
返礼、ありがとうございます。
>1)番号を入力するテキストボックスは「TextBox2」で良いのでしょうか?
「TextBox1」なのでしょうか?
「TextBox1」に、入力してください。
>2)ボタンは「CommandButton3」しかありませんが、
「CommandButton3」のボタンだけで検索に行くのでしょうか?
「CommandButton3」だけで、検索するように、書き換えます。
また、「TextBox1」に入力した番号に、123456A,B...Gなどが
有っても良いようにしました。
Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Dim 前側FName As String
Dim i As Long
If TextBox1.Value = "" Then Exit Sub
TextBox2.Value = "C:\A" & "\" & TextBox1.Value & ".pdf"
Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
i = InStrRev(FName, ".")
If Mid(FName, i - 1, 1) Like "[A-Z]" Then
前側FName = Left(FName, i - 2)
Else
前側FName = Left(FName, i - 1)
End If
If Dir(FName, vbNormal) = "" Then
For i = 65 To 90
If Dir(前側FName & Chr(i) & ".pdf", vbNormal) <> "" Then
'Chr(65)...A, Chr(66)...B, Chr(90)...Z
FName = 前側FName & Chr(i) & ".pdf"
Exit For
End If
Next i
If i > 90 Then 'for...nextで見つからなかった時にiは91
MsgBox "ファイルが見つかりません。", vbExclamation
Set WSH = Nothing
Exit Sub
End If
TextBox2.Value = FName
End If
WSH.Run """" & FName & """", 3
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With
Set WSH = Nothing
End Sub
別途、コードを書き換えて頂きありがとうございます。
ボタン1発でパターンA)とB)の両方に対応しているので、びっくりしました。
非常に苦労していろいろ考えていたので助かりました。
説明が長く、複雑な質問に丁寧に答えて頂き本当にありがとうございます。
機会がありましたら、またお願いします。
今回は解答して頂きありがとうございました。
※ベストアンサーですが他の方のアドバイスがあるかもしれないので、
しばらく質問は開けておきます。
No.4
- 回答日時:
>しばらく質問は開けておきます。
と云うことなので、ちょっとだけ回答させていただきます。
フォルダ内のファイル名が、「図番」もしくは「図番+改正コード」でユニークになっているのであれば、こんな感じでいけると思います。
ZZ-TOPさんの書いたコードをベースにしているので、読んでいただければ理解できると思いますが、念のため、変更点だけ仕様を書いておきます。
【仕様】
テキストボックス1に入力されているファイル名に、”?”(任意の1文字を表すワイルドカード)を付加して、実際に存在しているファイル名を求める。
ファイルが存在していない場合、その旨メッセージを表示して終了。
存在していれば、その名前をテキストボックス2へ転記。以降は、ZZ-TOPさんの書いたコードと同じです。
Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Set WSH = CreateObject("Wscript.Shell")
FName = Dir("C:\A" & "\" & TextBox1.Value & "?.pdf", vbNormal)
If FName = "" Then
MsgBox "ファイルが見つかりません。", vbExclamation
Else
FName = "C:\A" & "\" & FName
TextBox2.Value = FName
WSH.Run """" & FName & """", 3
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With
End If
Set WSH = Nothing
End Sub
ご解答ありがとうございます。
試してみましたがバッチリです!
しかもTextBox2の表示があるので、
エラーの時、どこにアクセスに行ったのかわかるので、
メッチャ良いです。
今のところ知識不足で「これ何?」みたいな部分も
多いのですが、元のコードを流用して頂いているので、
大体の動作がわかるので、すごくためになりました。
こちらのサイトで、お世話になることが多いのですが、
ママチャリさんを始め、こちらの質問をよく読んで
質問の意味を理解して、ご解答して頂いている方には
本当に感謝しております。
今回は早くに、ご解答頂きコードの書き換えまで対処して頂いた
ki-aaaさんにベストアンサーをゆずりますが、
ご解答頂き、本当にありがとうございます。
機会がありましたら、またお願いします。
No.2
- 回答日時:
こんにちわ
>1)変数を使う時は変数を宣言しない
このような条件でコードを書いたことがないのでスルーします。
Private Sub CommandButton3_Click()
Dim WSH As Object
Dim FName As String
Dim 前側FName As String
Dim i As Long
Set WSH = CreateObject("Wscript.Shell")
FName = TextBox2.Value
前側FName = Replace(FName, ".pdf", "")
If Dir(FName, vbNormal) = "" Then
For i = 65 To 90
If Dir(前側FName & Chr(i) & ".pdf", vbNormal) <> "" Then
'Chr(65)...A, Chr(66)...B, Chr(90)...Z
FName = 前側FName & Chr(i) & ".pdf"
Exit For
End If
Next i
If i > 90 Then 'for...nextで見つからなかった時にiは91
MsgBox "ファイルが見つかりません。", vbExclamation
Set WSH = Nothing
Exit Sub
End If
TextBox2.Value = FName
End If
WSH.Run """" & FName & """", 3
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lastRow, 1) = TextBox1.Value
End With
Set WSH = Nothing
End Sub
ご解答ありがとうございます。
頂いたコードについて以下の3点について教えて下さい。
1)番号を入力するテキストボックスは「TextBox2」で良いのでしょうか?
「TextBox1」なのでしょうか?
2)ボタンは「CommandButton3」しかありませんが、
「CommandButton3」のボタンだけで検索に行くのでしょうか?
※こちらのMacro1では
①「下の窓へ」で一度、下のテキストボックス(TextBox2)にフルパスが記載されます。
そのあとで、③の検索ボタンを押して検索を実行してますので、
一応、他にボタンがないか確認させて下さい。
3)HDDがC:とD:の2台あります。
テキストボックスを空白にして検索をかけるとエクスプローラーの
「コンピュータ」の画面で止まります。
※エラーメッセージが出ません
すいませんが以上の3点について教えて下さい。
※こちらの知識不足で説明して頂いてもわからない場合があります。
ストレスにならない範囲で答えて頂ければOKです。
今回はご解答頂きありがとうございます。
せっかく教えて頂いたのですが、わからないかもしれませんが、
VBAの勉強中なので勉強のヒントになればそれでいいです。
今回はご解答頂きありがとうございます。
No.1
- 回答日時:
ややこしく複雑な事をするのですね。
文書・データーが更新されたら、(_A)と言う様に「アンダーバーを付けて通し記号」を付けます。
*ファイル名の後に(1)・・(5)とかでも可能です。
同じファイルはディレクトリで整理です。
データーを更新したら、(_?)を大きくしていきます。
このような状態で、マクロ?を使った事はありません。
データー名の見本を添付しました。
**意図が違っていたらごめんなさい。
ご解答ありがとうございます。
>ややこしく複雑な事をするのですね。
ごもっともだと思います。
なので、簡単に説明しますね。
1)本当はフォルダーが深い
※図面番号の上2ケタ~4ケタでフォルダーが作成されています。
なので、本当はサブフォルダーから検索する必要があります。
※サブフォルダーを指定するマクロはこちらで作成してます。
2)大量に図面がある
1)で説明したとおりサブフォルダーだけで100個以上あります。
その中に数千枚の図面があります。しかも不定期に数枚単位で改正がかかります。
※改正コードは得意先が決めるので、こちらでは勝手なコードを付与することができません。
3)「工場の現場のタブレットPCから~」ということで、
タブレットの使用者は工場の作業者なので、手袋を着用しております。
そのため、こちらでユーザーフォームを作成し、
ボタンを押しやすいインターフェイスを用意しております。
通常のようにキーボード(ソフトウエア)やマウスからの操作はできません。
という事情です。
リンク先の
http://bit.ly/2awqTb2
http://bit.ly/29gdmC4
を閲覧して頂ければ幸いです。
今回はご解答頂きありがとうございます。
良い方法、アドバイスがございましたらまたお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
最近、いつ泣きましたか?
泣いてストレス発散! なんて言いますよね。 あなたは最近いつ、どんなシチュエーションで泣きましたか?
-
人生最悪の忘れ物
今までの人生での「最悪の忘れ物」を教えてください。 私の「最悪の忘れ物」は「財布」です。
-
メモのコツを教えてください!
メモを取るのが苦手です。 急いでメモすると内容がごちゃごちゃになってしまったり、ひどいときには全く読めない時もあります。
-
【大喜利】世界最古のコンビニについて知ってる事を教えてください【投稿~10/10(木)】
【お題】 ・世界最古のコンビニについて知ってる事を教えてください
-
架空の映画のネタバレレビュー
映画のCMを見ていると、やたら感動している人が興奮で感想を話していますよね。 思わずストーリーが気になってしまう架空の感動レビューを教えて下さい!
-
ユーザーフォームでTextBox1にカーソルを移動したい
Excel(エクセル)
-
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
エクセルVBA マルチページのSetFocus
PowerPoint(パワーポイント)
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・14歳の自分に衝撃の事実を告げてください
- ・架空の映画のネタバレレビュー
- ・「お昼の放送」の思い出
- ・昨日見た夢を教えて下さい
- ・【お題】絵本のタイトル
- ・【大喜利】世界最古のコンビニについて知ってる事を教えてください【投稿~10/10(木)】
- ・メモのコツを教えてください!
- ・CDの保有枚数を教えてください
- ・ホテルを選ぶとき、これだけは譲れない条件TOP3は?
- ・家・車以外で、人生で一番奮発した買い物
- ・人生最悪の忘れ物
- ・【コナン30周年】嘘でしょ!?と思った○○周年を教えて【ハルヒ20周年】
- ・ハマっている「お菓子」を教えて!
- ・最近、いつ泣きましたか?
- ・夏が終わったと感じる瞬間って、どんな時?
- ・10秒目をつむったら…
- ・人生のプチ美学を教えてください!!
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・都道府県穴埋めゲーム
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ギターのTAB譜の記号 N.C....
-
ギターコードについて
-
草刈の際に電源ケーブルを切断...
-
マイクロソフト 一時使用コード...
-
onって何ですか?
-
先日、電気コードに熱いお湯か...
-
Hey!Say!のCDについている、ユ...
-
ギターコードの本でおすすめあ...
-
サイトによってコード譜が違う...
-
ギターでコードを押さえていた...
-
情熱をなくさないで ギターコード
-
こんにちは。 私の車はデイズル...
-
掃除機のコードをまとめる
-
ギターコードの転調
-
ジャズギターのコード
-
岡林信康「自由への長い旅」の...
-
この写真の状態(銅線剥き出し)...
-
ピアノのコードについて…
-
ドライアーのコードから煙が出...
-
実行時エラー3251対応処理方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ギターのTAB譜の記号 N.C....
-
Hey!Say!のCDについている、ユ...
-
VBA ダブルクリックするたびに...
-
ドライアーのコードから煙が出...
-
草刈の際に電源ケーブルを切断...
-
【マクロ】PasteSpecialメソッ...
-
マイナーの裏コードは存在する?
-
ギターで2弦2フレットと3弦2フ...
-
DLookupがうまく出来ません
-
【HULFT】 utllist とutladmin
-
Jeff Beck「Red Boots」のコー...
-
【EXCEL-VBA】PDFファイルを開...
-
VBAのフォーム上にTextBoxたく...
-
CODE関数から他の文字コードの...
-
ピアノのコードについて…
-
◎PPMのコードをお教えいただ...
-
マイクロソフト 一時使用コード...
-
JOBコードってなんでしょうか?
-
【マクロ】functionプロシージ...
-
流用の定義について
おすすめ情報