出産前後の痔にはご注意!

こんにちは、お世話になっております。VBAエクセルマクロについての質問です。
よろしくお願いします。

仕様なんですが、
1.ボタンクリック後、マクロ実行範囲のセルをドラッグ指定(Ctrlでの選択も可)
2.フォルダ選択を2回起こす(この質問ではそれぞれのファイルパスをAとBとする)
※1回目の前に「画像フォルダBを選択してください。」のメッセージボックスを挿入
※1回目と2回目の間に「画像フォルダBを選択してください。」のメッセージボックスを挿入
※2回目の後にも「処理を開始します。」のメッセージボックス
3.1.で選択した範囲内のセルに予め入れたファイル名と同じファイル名の画像をパスAから挿入
4.1.で選択した範囲内のセルに予め入れたファイル名と同じファイル名の画像をパスBから挿入
5.入力したファイル名の画像がない場合、もしくは空白のセルが範囲内にある場合はセルを灰色に塗りつぶし、斜線を挿入する。
貼り付ける画像はセルの中心ですが、倍率の変更等はしないです。
色々ネット等を回って貼り合わせで途中まで作ったのですが…

Sub ボタン2_Click()
Const n As Long = 2 'margin
Dim r As Range
Dim i As Long
Dim x As Double
Dim s As String
Dim t As String
Dim m As VbMsgBoxResult

With ActiveSheet
'メッセージボックス処理
m = MsgBox("画像フォルダAを選択してください。", vbOKCancel + vbExclamation)
If m = vbCancel Then
MsgBox "処理を中止します。", vbCritical
Exit Sub
Else
End If

'フォルダ選択の構文
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
t = .SelectedItems(1) & "\"
End With

'Forループ内_画像貼り付けの構文
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step 6
Set r = .Cells(i, 2).MergeArea
s = t & .Cells(i, 2).Value & ".jpg"

'画像がない場合の処理
If Dir(s) = "" Then
ActiveSheet.Cells(i, 2).Interior.ColorIndex = 16 ' 背景色
ActiveSheet.Cells(i, 2).Borders(xlDiagonalUp).LineStyle = xlContinuous ' 斜線
End If

'貼り付け画像について
With .Pictures.Insert(s).ShapeRange
.LockAspectRatio = msoTrue
x = Application.Min(r.Width / .Width, (r.Height - n) / .Height)
.Width = .Width * x
.Left = r.Left + (r.Width - .Width) / 2
.Top = r.Top + (r.Height - .Height) / 2

End With
Next
MsgBox "処理が完了しました。"
End With
End Sub

これからどこをどういじっていけば理想とするプログラムができるのか皆目検討もつけずに往生しております。
ご教示の程よろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

もう 色々ありすぎて、何からいえばいいか



>1.ボタンクリック後、マクロ実行範囲のセルをドラッグ指定(Ctrlでの選択も可)
ボタンクリックしたら後は手動操作できないと考えてください。
必要なら別のボタンを用意することになりますが
この条件だけなら先に選択しておいてクリックが妥当では?

ステップ実行は判りますか?
或はブレークポイントの設定でもいい。
ステップ実行すればファイルを決定する所が無い事くらい
わかるんじゃないかな?

全体を一気に考えるんじゃなくて 例えば
>1.で選択した範囲内のセルに予め入れたファイル名と同じファイル名の画像をパスAから挿入

ここの日本語そもそも判らないんだけど
(予め入れたファイル名と同じファイル名ってあらかじめ入れる話がどこにもないけど)
○ファイル名の取得はどうするのか?
○「と同じ」って、即ち比較するんだろうけど
何と何を比べるのか?
○画像をパスAから挿入(パスは画像じゃないからね、あくまでも場所)
これ、画像ファイル名が判ってたらプログラム構文に出来るのか?

それら一つ一つを積み重ねて出来るわけです。
それからすると沢山聞きすぎです。

ばらばらにしてからひとつづつ判らない点を尋ねてください。
例えばファイル名を選択して決定するにはどうするか?
一つの画像ファイルを貼り付けできるのか?等です。
個々が出来ても組み合わせ方もまた難しいんです。

ひとつひとつさえ出来ないのに最終形って高望みはやめましょう?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

Qマクロでセルに入れたファイル名の画像を隣のセルに読み込む

こんにちは。宜しくお願いします。

マクロで「セルに入れたファイル名の画像を隣のセルに読み込む」作業を行いたいのですが・・・。うまくいきません。どなたかご助言いただけると助かります。

<内容>
セル内には上から1位・2位と順位通りになっており、その順位に入っているセルのファイル名と一致している画像を隣のセルに読み込みたいと思っています。またファイル名と画像が一致しない場合は「No Image」として1枚の画像を貼り付けることもしたいです。

   A(順位)  B(名)    C(画像)
---------------------------------------------
1   1位   test01   D:\画像\teet01.JPG
2   2位   test02   D:\画像\teet02.JPG
3   3位   test03   D:\画像\teet03.JPG
.
.
.
10  10位   test10   D:\画像\teet10.JPG

<問題点>
・B2の「test01」から順に読み込んでもらいたいのにB1の「名」を読み込んでしまうためエラーが生じる。
・画像をセルの結合した分の大きさに合わせたいのだが、セル1個分のサイズに表示してしまうためうまく調節できない。

<マクロ文>
Private Sub CommandButton1_Click()

Dim i As Long
Dim myPic As Object
Dim myCell As Range

For i = 1 To Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
Set myCell = Range("C" & i)
Set myPic = ActiveSheet.Pictures.Insert("D:\画像\" & myCell.Value & ".JPG")
With myPic
.Width = Range("D2").Width
.Height = Range("D2").Height
End With
Set myPic = Nothing
Next i

End Sub

色々とネット等を見てはいるのですが・・・うまくいきませんでした。
どこをどのようにして代えればうまく動作するか分かる方いらっしゃいましたら教えていただきたいです。宜しくお願い致します。

こんにちは。宜しくお願いします。

マクロで「セルに入れたファイル名の画像を隣のセルに読み込む」作業を行いたいのですが・・・。うまくいきません。どなたかご助言いただけると助かります。

<内容>
セル内には上から1位・2位と順位通りになっており、その順位に入っているセルのファイル名と一致している画像を隣のセルに読み込みたいと思っています。またファイル名と画像が一致しない場合は「No Image」として1枚の画像を貼り付けることもしたいです。

   A(順位)  B(名)    C(画像)
...続きを読む

Aベストアンサー

倍率の変更もですが、それより Top 位置の調整が必要です。

Sub try_2()
  Const n As Long = 2 'margin
  Dim r As Range
  Dim i As Long
  Dim x As Double
  Dim s As String
  
  With ActiveSheet
    For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step 6
      Set r = .Cells(i, 3).MergeArea
      s = "D:\画像\" & .Cells(i, 2).Value & ".jpg"
      If Dir(s) = "" Then
        s = "D:\画像\noimage.jpg"
      Else
        Dir Application.Path
      End If
      'r.Item(1).Value = s
      With .Pictures.Insert(s).ShapeRange
        .LockAspectRatio = msoTrue
        x = Application.Min(r.Width / .Width, (r.Height - n) / .Height)
        .Width = .Width * x
        .Left = r.Left
        .Top = r.Top + n / 2
      End With
    Next
  End With
  
  Set r = Nothing
End Sub

こんな感じで n の数値を変更して調整してください。
必要であればWidthとLeftも同じように。

中央に配置したい場合は以下に変更。
.Left = r.Left + (r.Width - .Width) / 2
.Top = r.Top + (r.Height - .Height) / 2

倍率の変更もですが、それより Top 位置の調整が必要です。

Sub try_2()
  Const n As Long = 2 'margin
  Dim r As Range
  Dim i As Long
  Dim x As Double
  Dim s As String
  
  With ActiveSheet
    For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row Step 6
      Set r = .Cells(i, 3).MergeArea
      s = "D:\画像\" & .Cells(i, 2).Value & ".jpg"
      If Dir(s) = "" Then
        s = "D:\画像\noimage.jpg"
      Else
...続きを読む

Q【配列の練習中】変数(範囲)に格納した値を別シートの特定のセルに表示

VBAを練習中で、現在、配列について練習しております。
”要素”シートのセル範囲を配列に格納し、”出力”シートの特定セルに表示させたいです。
例示してある”要素”シートは数行ですが、この行が数百行有るような場合を想定しています。
変数(i)も変化させ、要素シートの中から特定(i)の行を格納し、出力に表示させたいです。
住所録(データシートが要素で、個々の情報を出力に呼び出す)みたいな感じを想定しています。

自分なりに調べながら書いたコード、シート情報を記載します。
よろしくお願いいたします。


Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim youso As Range
Dim i As Long

Set sh1 = Worksheets("要素")
Set sh2 = Worksheets("出力")

i = 2 '必要に応じてiの値を変える予定あり

Set youso = sh1.Range(Cells(i, 1), Cells(i, 5))

'↑ここでエラーが出ます。

With sh2
.Range("C2") = youso(1) '要素1
.Range("F2") = youso(2) '要素2
.Range("D4") = youso(3) '要素3
.Range("D6") = youso(4) '要素4
.Range("G5") = youso(5) '要素5
End With

End Sub

VBAを練習中で、現在、配列について練習しております。
”要素”シートのセル範囲を配列に格納し、”出力”シートの特定セルに表示させたいです。
例示してある”要素”シートは数行ですが、この行が数百行有るような場合を想定しています。
変数(i)も変化させ、要素シートの中から特定(i)の行を格納し、出力に表示させたいです。
住所録(データシートが要素で、個々の情報を出力に呼び出す)みたいな感じを想定しています。

自分なりに調べながら書いたコード、シート情報を記載します。
よろしくお願いい...続きを読む

Aベストアンサー

こんにちは。

そのコードですと、配列になっていないのです。
配列を、簡単な方式で書いてみました。すこし複雑になってしまいますね。

Sub 配列方式()
 Dim Sh1 As Worksheet
 Dim Sh2 As Worksheet
 Dim youso As Range
 Dim Ary_youso(4)  '配列変数
 Dim Rng As Range
 Dim i As Long, j As Long, c As Range
 Set Sh1 = Worksheets("要素")
 Set Sh2 = Worksheets("出力")
  i = 2 '行
 With Sh1
  Set youso = .Range(.Cells(i, 1), .Cells(i, 5))
  Next j
  For j = 0 To 4
   Ary_youso(j) = youso(j + 1).Value '配列変数に入れる
 End With
 j = 0
 With Sh2
 Set Rng = .Range("C2,F2,D4,D6,G5")
 For Each c In Rng
  c.Value = Ary_youso(j)  '配列変数からの吐き出し
  j = j + 1
 Next c
 End With
End Sub

こんにちは。

そのコードですと、配列になっていないのです。
配列を、簡単な方式で書いてみました。すこし複雑になってしまいますね。

Sub 配列方式()
 Dim Sh1 As Worksheet
 Dim Sh2 As Worksheet
 Dim youso As Range
 Dim Ary_youso(4)  '配列変数
 Dim Rng As Range
 Dim i As Long, j As Long, c As Range
 Set Sh1 = Worksheets("要素")
 Set Sh2 = Worksheets("出力")
  i = 2 '行
 With Sh1
  Set youso = .Range(.Cells(i, 1), .Cells(i, 5))
  Next j
  For j = 0 To 4
   Ar...続きを読む

QVBA 再帰について

こんばんは
再帰についておしえてください。
実行結果は120となります。
F8で動作を追っていくと
Sample_subに5を渡してn<=1になるとENDIFにうつり
その後、END funtionとEndifの間をいききしております。
どうして、こういう動作をするのでしょうか?
よろしくおねがいいたします。

Sub sample()
MsgBox sample_sub(5)
End Sub
Function sample_sub(ByVal n As Integer)
If n <= 1 Then
sample_sub = 1 'ここで再帰処理は終了します。
Else
sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
End If
End Function

Aベストアンサー

VBA の
Function名 = 戻り値
って書き方に惑わされていませんか?
> sample_sub(5)
で呼び出したときの sample_sub=〜 と、その中の
> sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
にある sample_sub(n - 1) で呼び出されたときの sample_sub=〜 とは、別なものになります。
「一つの変数sample_sub」 の値が変化しているわけではありません。
ステップ実行で見ると、プログラムの同じ行を指しているので「一つの変数sample_sub」 の値が変化している」様に見えてしまいますが、そうではないのです。


別の例を用意します。
sample_sub(5) で呼び出したのと、同じ動きをする関数 sample_sub_5 を作ります。

Function sample_sub_5()
If 5 <= 1 Then
sample_sub_5 = 1
Else
sample_sub_5 = 5 * sample_sub_4()
End If
End Function

同様に4〜1を用意します

Function sample_sub_4()
If 4 <= 1 Then
sample_sub_4 = 1
Else
sample_sub_4 = 4 * sample_sub_3()
End If
End Function

Function sample_sub_3()
If 3 <= 1 Then
sample_sub_3 = 1
Else
sample_sub_3 = 3 * sample_sub_2()
End If
End Function

Function sample_sub_2()
If 2 <= 1 Then
sample_sub_2 = 1
Else
sample_sub_2 = 2 * sample_sub_1()
End If
End Function

Function sample_sub_1()
If 1 <= 1 Then
sample_sub_1 = 1
Else
sample_sub_1 = 1 * sample_sub_0()
End If
End Function


この sample_sub_5() での動作は、 sample_sub(5) とまったく同じになります。

VBA の
Function名 = 戻り値
って書き方に惑わされていませんか?
> sample_sub(5)
で呼び出したときの sample_sub=〜 と、その中の
> sample_sub = n * sample_sub(n - 1) 'ここで自分自身を呼び出しています。
にある sample_sub(n - 1) で呼び出されたときの sample_sub=〜 とは、別なものになります。
「一つの変数sample_sub」 の値が変化しているわけではありません。
ステップ実行で見ると、プログラムの同じ行を指しているので「一つの変数sample_sub」 の値が変化している」様に見えてしまいますが、そ...続きを読む

Qエクセルvba 一つ上の行を指定した回数分コピーする。

教えて下さい。vba初心者です。

A B C D E F G H
7 522 加藤 沖縄 みかん 縄 1 1/5 空欄
8 123 吉田 愛媛 りんご 水 3 2/10 空欄

1️⃣一番最後に入力した行をすぐ下にコピーしたい。(ここでは7行目…入力して行くと行は増えます。)
2️⃣指定回数はE列。

この列ではE列が3回になりますので、
コピーしたい範囲はA〜G列を、すぐ下の8行〜9行までの2回分コピーしたいです。

完成希望例
A B C D E F G H
7 522 加藤 沖縄 みかん 縄 1 1/5 空欄
8 123 吉田 愛媛 りんご 水 3 2/10 空欄
9 123 吉田 愛媛 りんご 水 3 2/10 空欄
10 123 吉田 愛媛 りんご 水 3 2/10 空欄

にしたいです。

教えて下さい。vba初心者です。

A B C D E F G H
7 522 加藤 沖縄 みかん 縄 1 1/5 空欄
8 123 吉田 愛媛 りんご 水 3 2/10 空欄

1️⃣一番最後に入力した行をすぐ下にコピーしたい。(ここでは7行目…入力して行くと行は増えます。)
2️⃣指定回数はE列。

この列ではE列が3回になりますので、
コピーしたい範囲はA〜G列を、すぐ下の8行〜9行までの2回分コピーしたいです。

完成希望例
A B C D E F G H
...続きを読む

Aベストアンサー

前の絵のリスト範囲の所、名前定義も使えますよ。
というか、数式を入れるところの右のボタンみたいのを
押すと、入力する代わりにマウスで別シートでも
ドラッグで範囲指定できるから、範囲指定とぴったり
合致すれば、勝手に名前に変換されるみたいだった。
名前で指定の時、先頭に=はつけないみたいです。

ボタンはどっちをお使いですか?
呼び出している subの名前で判ります。
Private Sub CommandButton1_Click()
と決まっているのがActiveXの方です。

QVBA シリアル値から月日への変換

VBAで、A列 i行のシリアル値(例えば 42841)を月日データ(4月16日)に変換したいのですが、Cells(i, "A").NumberFormatLocal = "m""月""d""日"";@" の様にしても Cells(i, "A") の中味はシリアル値のままで全く変化しません。
i は1毎にインクリメントさせていますが、ネットで検索してもこの様な例を見つける事ができませんでした。
どなたか教えて頂ければ幸いです。

Aベストアンサー

No1です。
以下のマクロを標準モジュールに登録し実行しました。
こちらの環境では、4月16日が表示されるようになりました。添付図の実行前と実行後を参照ください。

Public Sub test()
Dim i As Long
For i = 1 To 30
Cells(i, "A").NumberFormatLocal = "m""月""d""日"";@"
Next
End Sub


cells(i,"A")はアクティブシートに対して作用します。
あなたが、月日データにしたいシートはアクティブシートになってますか。

Qエクセルで、セルに入っている文字列をファイル名、シート名として呼び出す方法がわかりません

A1にはファイル名(たとえば"平成29年家計簿.xlsx"といった具合に)
A2にはそのファイルの中のシートの名前(たとえば”1月”というシート)

つまり平成29年家計簿というファイルの1月というシート、そのA10に入っている数値を呼び出したいのです。最初に式だけ作っておいてA1とA2の文字列を変えることで28年のものにしたり2月のものを呼び出したりといったものを作りたいのですが、どうしても数式が作れなくてこまっています。
ネットで調べてもみたのですが、A1に入っている文字列をファイル名として呼び出す方法(indirect関数を使った方法)や、反対にA1に入っている文字列をシート名として呼び出す方法は見つかったのですが、その二つを組み合わせた方法がどうしてもみつかりませんでした。

エクセルに詳しい方、どうかよろしくおねがいします。

Aベストアンサー

=INDIRECT("[" & A1 & "]" & A2 & "!" & "A10")
で良いかと。但し、A1で示されるブックを開いてないとエラーになります。

Qエクセルで該当する条件のデータがある行を一気に削除したい

添付ファイルのようにidとnameが格納されたエクセルで、削除idに該当するデータ行を一気に削除した上で行間を詰めたいと考えていますが、どのようにすれば間単に削除できますか?

削除id
4
7
11
12
13
17
※削除idもエクセルデータで格納されています。
※実際にはデータ数が10万件~で削除しなければいけないidが1000程度あります。

ご存知の方、教えていただけますと幸いです。

Aベストアンサー

これは、#8様の回答をマクロにしたものです。

'//
Sub ExtractMacro1()
 'フィルターオプションを使った方法
 Dim sh1 As Worksheet
 Dim sh2 As Worksheet
 Dim shNew As Worksheet '新しいシート
 Dim Rng As Range 'データ用
 Dim Rng2 As Range '削除用
 Dim criteADD As String '削除のデータアドレス
 
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
 
 With sh2
  '削除用ID
  Set Rng2 = .Range("C2", .Cells(Rows.Count, "C").End(xlUp))
  criteADD = Rng2.Address
 End With
 '新規の貼り付け用のシート
 Set shNew = Worksheets.Add(Before:=ActiveSheet)
 'shNew.Name ="更新済み"
 With sh1
  '範囲の設定
  .Activate '
  Set Rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Resize(, 29)) 'AC まで
  'クライテリアの作成 (AF2)に置く
  .Range("AF2").FormulaLocal = "=COUNTIF(" & sh2.Name & "!" & criteADD & ",G2)=0"
  
  'フィルターオプションの実行(新しいシートに貼り付け)
  Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
  "AF1:AF2"), CopyToRange:=shNew.Range("A1"), Unique:=False
  .Range("AF1:AF2").ClearContents
 End With
End Sub

これは、#8様の回答をマクロにしたものです。

'//
Sub ExtractMacro1()
 'フィルターオプションを使った方法
 Dim sh1 As Worksheet
 Dim sh2 As Worksheet
 Dim shNew As Worksheet '新しいシート
 Dim Rng As Range 'データ用
 Dim Rng2 As Range '削除用
 Dim criteADD As String '削除のデータアドレス
 
 Set sh1 = Worksheets("Sheet1")
 Set sh2 = Worksheets("Sheet2")
 
 With sh2
  '削除用ID
  Set Rng2 = .Range("C2", .Cells(Rows.Count, "C").End(xlUp))
  criteADD = Rng2.Ad...続きを読む

QExcelで日数を計算したい。

はじめまして。Excelを使用している中でどうしてもわからない事があり今回質問させていただきます。「どこから」+「どこまで」の日数を合わせての計算式を出したいんですけどこの計算ってExcelどうやるんですか?佐川急便の検索ツールのやつですがこのように検出したいのでやり方を教えてくれる方いませんか?

Aベストアンサー

僕も無意味に結合セルを使うのはお勧めしません。

それ以前に最終形態へのビジョンはありますか?
今5*5で25(北海道のせいで図は20だけど)マスですよね。
これ47*47ですよ。2200超えマス。

まずそれだけの個々の日数を調べるの?驚異的じゃありません?
(ま、実は多少の軽減策もなくはないですが。)

次に結合をすすめない理由の一番は、これは見せる部分じゃなく
参照するデータだってことです。
そしたらこれが縦横47に広がったときを想像してみてください。
無駄に行を使わず詰まっている方が全体が見やすいのは自明でしょ?
例えば、今の5:6行はセル結合などせずに縦書きにしたら横幅が
うんと狭く出来て、端まで見るとき横スクロールが激減させられます。

データとしてのメンテナンス性が第一なんです。

参照で関数とかを使うときに結合セルで構成されていると
そもそも空白交じりのデータになるから、うっかり誤動作の
恐れが高くなるんです。例えば一つ下のを見るとき2を足さないと
いけないとか、参照するのにいちいちそんな面倒な事しなきゃいけない
なんて効率悪すぎます。

あとこの表は参照するテーブルになるので名前定義を
マスターしておくと、別シートでもあるから
式がうんと楽になります。

僕も無意味に結合セルを使うのはお勧めしません。

それ以前に最終形態へのビジョンはありますか?
今5*5で25(北海道のせいで図は20だけど)マスですよね。
これ47*47ですよ。2200超えマス。

まずそれだけの個々の日数を調べるの?驚異的じゃありません?
(ま、実は多少の軽減策もなくはないですが。)

次に結合をすすめない理由の一番は、これは見せる部分じゃなく
参照するデータだってことです。
そしたらこれが縦横47に広がったときを想像してみてください。
無駄に行を使わず詰まっている方が全体が見や...続きを読む

QVBA初心者です。ファイルの検索、貼り付け方を教えてください。

はじめまして。
中小企業の工場で働いている者です。

伝票作成の効率化のため
選択したセルの部品のファイルを特定のフォルダから検索し、注文番号を張り付ける、
というマクロを作成したいと思うのですが、
VBA初心者の私にはプログラムを作れそうにありません。

誰かお力添え頂けませんでしょうか。


具体的には、まず、下のような、注文一覧表Ⅰがあり、
B列に顧客NO.、C列に注文番号、F列に部品番号を入力しています。

------A ---------- B---------------C------------D -------------E ----------- F
1---------------顧客NO.--------注文番号----------------------------------部品番号
2----------------aaa ------------注文あ-------------------------------------部品い
3----------------bbb-------------注文う------------------------------------部品え
4----------------ccc-------------注文お-------------------------------------部品か



F2の『部品い』のセルをクリックし、マクロのボタンを押すと
デスクトップ上の「伝票一覧Ⅱ」のショートカットファイル(伝票一覧Ⅱは会社のサーバー内のファイル)から『部品い』を含むエクセルファイルを検索し開く。

『部品い』のエクセルファイルは、Sheet1からSheet3まであり
(伝票一覧Ⅱのエクセルファイルは、必ず、Sheet1からSheet3まであります。)、
まず、Sheet3のL1のセルに
注文一覧表Ⅰの『部品い』と同じ行のC列の『注文あ』を張り付ける。

Sheet3
---A-B-C-D-E-F-G-H-I-J-K-------L
1---------------------------------注文あ

次に、Sheet2の「注文番号」と書いてあるセルの同列の1つ下の行のセルに
注文一覧表Ⅰの『部品い』と同じ行のC列の『注文あ』を張り付ける。
(若干、部品によって、様式(注文番号と書いている行列)が違います。)

Sheet2(例えば)
---A-B-C-D-E-F-G-H-I-J-------K
1------------------------------注文番号
2------------------------------注文あ

続いて、
Sheet1の「注文番号」と書いてあるセルの同行の1つ右の列のセルに
注文一覧表Ⅰの『部品い』と同じ行のC列の『注文あ』を張り付ける。
また、
「管理番号」と書いてあるセルの同行の2つ右のセルに、
注文一覧表Ⅰの『部品い』と同じ行のC列の『注文あ』を張り付ける。
また、
『顧客NO.』と書いてあるセルの同行の1つ右の列のセルに、
注文一覧表Ⅰの『部品い』と同じ行のB列の『aaa』を張り付ける。
 
Sheet1(例えば)
-----A--------------B--------C-------D-E-F-G-H-I-------------J------------K  
1--------------------------------------------------------------注文番号-----注文あ
2--管理番号----------------注文あ
3
4--顧客NO.-------aaa
            

次に、デスクトップ上の「伝票一覧Ⅲ」のショートカットファイル(伝票一覧Ⅲも会社のサーバー内のファイル)から『部品い』を含むファイル(DocuWorks文書 (.xdw))を検索。検索結果の表示。

以上になります。

その後、注文一覧表Ⅰの『部品え』、『部品か』と伝票を出していきますが、
間違えないように、1部品毎、プリントアウトしていく予定でおります。

よろしくお願い致します。

はじめまして。
中小企業の工場で働いている者です。

伝票作成の効率化のため
選択したセルの部品のファイルを特定のフォルダから検索し、注文番号を張り付ける、
というマクロを作成したいと思うのですが、
VBA初心者の私にはプログラムを作れそうにありません。

誰かお力添え頂けませんでしょうか。


具体的には、まず、下のような、注文一覧表Ⅰがあり、
B列に顧客NO.、C列に注文番号、F列に部品番号を入力しています。

------A ---------- B---------------C------------D -------------E --...続きを読む

Aベストアンサー

>VBA初心者の私にはプログラムを作れそうにありません。

無理です。
というのは初心者は構わないんですが、
富士山に最初から登りたいというような話で
まずは近所の丘に着実に登ることから始めなければなりません。

質問は多岐にわたって判らないことだらけですよね。
このような状態で教えてもらっても理解できることはありません。
表題が「ファイルの検索、貼り付け方を教えてください。」
であるにも関わらず、内容は複雑。

質問はひとつづつ、尚且つ8割り型判っているけど
あと少しが乗り越えられないということを
一点ずつ尋ねて解決するのが上達への早道です。

そこでまずは「ファイルを特定のフォルダから検索し」
この一点だけを見てみましょう。
これはDir()で実現出来ます。
まず excel vba dir でググりましょう。
使い方が沢山出てきますから、自分の環境で試すんです。
それだけだって最初は簡単には行かない事が多いもので
その時にわからない点を尋ねるんです。

何時間もかかる話を丸投げしてはいけません。
天は自ら助くる者を助くです。

Qマクロの「SaveAs」でエラーが出るのを解消したいです(再)

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト...続きを読む

Aベストアンサー

No1の方が指摘されているように、
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText
のときの、 ws2.Cells(s, 5).Valueの値が不正な可能性があります。

この行の直前で、
msgbox("<" & ws2.Cells(s, 5).Value & ">")
を行い、ws2.Cells(s, 5).Valueの内容を確認しては、いかがでしょうか。


人気Q&Aランキング