[[20220107155600]]　『別シートのアドレスを参照して新規ファイル作成』（七味）　ページの最後に飛ぶ

『別シートのアドレスを参照して新規ファイル作成』（七味）

こんにちは。
本年度もこちらにお世話になります。
よろしくお願いします。

sheets("台帳")にユーザーフォーム1を作成し、
TextBox1とComboBox5に入力された値をCommandButton3をクリックしてsheets("台帳")転記するまでコードを作成しました。

Dim lastrow As Long

lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'A列の再最終行を取得

.Cells(lastrow, 1).Value = Me.TextBox1.Text 'A列の最終行
.Cells(lastrow, 2) = Me.ComboBox5.Text 'B列の最終行

※ComboBox5は別シートからデータを参照しています。
Private Sub UserForm_Initialize()

Dim q As Long

Worksheets("リスト").Activate
For q = 2 To Cells(Rows.Count, 2).End(xlUp).Row

    v1 = Trim(Cells(q, 2).Value)
            If Len(v1) = 0 Then
            Else
                    ComboBox5.AddItem Cells(q, 2).Value
            End If
Next q

次にCommandButton3をクリックしたときに
sheets("リスト")を参考にファイルを新規作成保存をしたいです。

sheets("リスト")の入力内容は下記になります。
A列　…　番号
B列　…　名称　'ComboBox5のデータ参照先
C列　…　ファイル保存先のアドレス
D列　…　ファイルの原紙のパス

保存先、原紙が入力されていないセルがあり空白があります。
そのため、msgbox"保存先がありません"または"原紙がありません"と
メッセージを表示する必要があります。

ComboBox5と一致するB列を探し出し、
同じ行のD列のファイルパスで新規作成、
同じ行のC列のアドレスへ保存したいです。

ファイル名はTextBox1に入力された値を参照にしたいです。

    Dim myName As String  '名称
    Dim myNumber As String '番号

myNumber = UserForm2.TextBox1.Text '番号
myName = UserForm2.ComboBox5.Text '測定器名称

myNumber & ".xlsx"

ファイルを作成後、
sheets("台帳")のA列にリンクを張り付け。
.Hyperlinks.Add anchor:=.Cells(lastrow, 1)

ここまでの動作コードを教えて下さい。
以上、よろしくお願いします。

ComboBox5は別シートのsheets("リスト")のB列を参照してます。

＜使用 Excel：Office365、使用 OS：unknown ＞

ご参考。

＞ComboBox5と一致するB列を探し出し
https://www.google.com/search?q=vba+%E4%B8%80%E8%87%B4%E3%81%99%E3%82%8B%E3%82%BB%E3%83%AB%E3%82%92%E6%8E%A2%E3%81%99

＞同じ行のD列のファイルパスで新規作成、
＞同じ行のC列のアドレスへ保存したいです。
「D列のファイルパス」から「C列のアドレス」へコピーして、ファイル名を変えればよろしいかと。
https://www.google.com/search?q=vba+%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%B3%E3%83%94%E3%83%BC+%E5%90%8D%E5%89%8D%E5%A4%89%E6%9B%B4
（ひまつぶし） 2022/01/07(金) 17:05

ひまつぶしさん、
上記リンク先をもとに考えてきます！
ありがとうございます！
（七味） 2022/01/11(火) 11:13

ユーザーフォーム1からデータを取得しセルに反映した後、
該当ファイルを新規作成保存をするマクロコードを作成しました。

'新規ファイル作成
Dim r As Long
Dim myName As String '名称
Dim myNumber As String '番号
Dim Path_NewFile As String '新しいファイルのパス
Dim Path As String '保存先セル
Dim NewFile As String 'ファイルセル

myName = UserForm2.TextBox1.Text
myNumber = UserForm2.ComboBox5.Text

'別シートから名称(ComboBox5)とB列が一致するセルを探す

r = Sheets("リスト").Range("B" & Rows.Count).End(xlUp).Row + 1 'B列最終行+1

For i = 2 To r

If Not Sheets("リスト").Cells(i, 2).Find(What:=ComboBox5, LookAt:=xlPart) Is Nothing Then

Path = Sheets("リスト").Cells(i, 3) '保存先
myNumber = UserForm2.TextBox1.Text 'ファイル名
NewFile = Sheets("リスト").Cells(i, 4) 'ファイル

'新しいファイルの作成
Path_NewFile = Path & "\" & myNumber & ".xls"
FileCopy NewFile, Path_NewFile

'リンクを貼る
.Hyperlinks.Add anchor:=.Cells(lastrow, 1), Address:=Path_NewFile

Unload Me 'フォームを閉じる
End If
Next i

一応動作はしますが、

Path = Sheets("リスト").Cells(i, 3)に
パスがないときは
msgbox"保存先の指定がありません"

NewFile = Sheets("リスト").Cells(i, 4) に
パスがないときは
msgbox"ファイルをの原紙がありません"
としたいのですが、どのようなコードを記述すればいいかわかりません。

教えて頂けないでしょうか。
よろしくお願いします。
（七味） 2022/01/11(火) 16:09

IF文の書き方が分からないという意味ですか？
パスが無いという状態をVBA上でどのようなコードになるか分からない、という意味ですか？
（tkit） 2022/01/11(火) 16:20

＞パスがないときは

「入力されていない」を確認するのか、
ファイルパスとして有効でない（ファイルやフォルダが存在しない）ことを確認したいのか
どちらでしょうか？

ほかにも、不思議なところがあります。
・ループしながら、１つのセルをFindでチェックしている
・原紙のファイル名が「NewFile」
（わからん） 2022/01/11(火) 16:57

説明不足ですみません。

「入力されていない」を確認する、ということです。
セルにファイルのパスを直接入力するので「入力の有無」を確認としたいです。

素人がわからないなりにコードを作成したので矛盾点があるのは重々承知です…
・・ループしながら、１つのセルをFindでチェックしている　→　…変ですね…
・原紙のファイル名が「NewFile」　→　Path_NewFile に変わってました。

再度検討してきます。

（七味） 2022/01/12(水) 09:23

＞「入力されていない」を確認する

＜参考＞
https://www.google.com/search?q=vba+%E7%A9%BA%E6%AC%84%E3%81%A7%E3%81%AA%E3%81%84%E5%A0%B4%E5%90%88

＞ループしながら、１つのセルをFindでチェックしている
B列に、見つけたいセルが１つしかないなら、見つかったあともループするのは無駄です。
また、「Sheets("リスト").Cells(i, 2).Find(・・」を、B列全体を指定するようにすれば
ループ不要になります

＞原紙のファイル名が「NewFile」
こちらは、なんとなく違和感があるというだけですので、お好みでどうぞ。

（わからん） 2022/01/12(水) 09:34

なるほど！
確かに行全体を指定すればループする必要はないですね。

Dim FoundCell As Range

Set FoundCell = Sheets("リスト").Range("B:B").Find(What:=ComboBox5)
If Not FoundCell Is Nothing Then

Path = FoundCell.Offset(0, 1) '保存先
myNumber = UserForm2.TextBox1.Text 'ファイル名
NewFile = FoundCell.Offset(0, 2) 'ファイル

'新しいファイルの作成
Path_NewFile = Path & "\" & myNumber & ".xls"
FileCopy NewFile, Path_NewFile

'リンクを貼る
.Hyperlinks.Add anchor:=.Cells(lastrow, 1), Address:=Path_NewFile

Unload Me 'フォームを閉じる

上記コードに変更しました！
こちらも変な箇所はありそうですがひとまず動きます。

次に「入力されていない」を確認するコードを検討してきます！
ご提案をありがとうございます！
（七味） 2022/01/12(水) 12:06

 ＞「入力されていない」を確認する、ということです。

 RangeまたはCellsの値を取得する場合Valueプロパティです。
 で、「入力されていない」ということは当該が空白ということなので、
 文字列""、もしくは文字数が0ということです。

 なので、if文で文字列""とイコール、またはLEN関数で文字数が0か
 判定すればいいでしょう。

（tkit） 2022/01/12(水) 15:23

If FoundCell.Offset(, 2).Value <> "" Then
のコードを追加してエラー無しで動作しました！！
多分あってる…ハズ！！

ありがとうございました！！
（七味） 2022/01/12(水) 15:50

コメント返信：

[ 一覧(最新更新順) ]

[[20220107155600]] 『別シートのアドレスを参照して新規ファイル作成』（七味） ページの最後に飛ぶ

[[20220107155600]]　『別シートのアドレスを参照して新規ファイル作成』（七味）　ページの最後に飛ぶ