Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

186 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【78733】Re:ファルダ内の画像を任意のセルに貼り...

VBA勉強中 - 17/1/11(水) 12:02 -


	引用なし

	パスワード

▼β さん：
追記です。
Set Pos = Pos.Offset(, 11)
の部分をselect case 構文を用いようと思います。
列がFの場合、右に11進める
列がQで17行下が空だった場合、左に11、下に17進める
列がQで17行下が空ではない場合(画像を入れるセル以外にはすべて文字が入力されています)、左に11、下に22進める

としてみようかと思います。

Select Case True
　　　　　　Case Pos = Sheets("sheet1").Range("F")
　　　　　　　　Set Pos = Pos.Offset(, 11)
　　　　　　Case Pos = Sheets("sheet1").Range("Q") & Pos.Offset(, 17) = ""
　　　　　　　　Set Pos = Pos.Offset(-11, 17)
　　　　　　Case Pos = Sheets("sheet1").Range("Q") & Pos.Offset(, 17) = "" = False
　　　　　　　　Set Pos = Pos.Offset(-11, 22)
　　　　End Select

このような風になりました。お時間あれば添削いただけると幸いです。

・ツリー全体表示


	【78732】Re:ファルダ内の画像を任意のセルに貼り...

VBA勉強中 - 17/1/11(水) 10:58 -


	引用なし

	パスワード

▼β さん：
すごすぎます、短時間、あの説明でここまで作っていただけるとは…ありがとうございます！
一通りわからないものについては調べて参りました。
Scripting.Dictionary、WScript.Shell　につきましてわからずでして
前者が重複を防いでほしいとこの画像をオブジェクトに指定している
後者はとても多くのメソッドとプロパティを内包しているんですね…
2つとも CreateObjectを使われていることから画像とファイルを操作できるように指定してしているのかな？といった認識です。合っていますか？
といっても CreateObjectも先ほど調べて把握したばかりで恥ずかしい話ですが…すごく便利なものですね

また、Set Pos = Pos.Offset(, 11)
ここです、これも説明不足で申し訳ないのですが
画像の貼り付け場所なのですが１ページに4枚貼ります、位置は左上、右上、左下、右下、の順になります。
これが20ページ以上ほどありまして自動化できないだろうかと考えている状態です
1ページ目の上下間と、1ページ目の下側と2ページ目の上側間が違うため（左側の列は常にF、右側はQです)
画像位置の順は、F5,Q5,F22,Q22,F44,Q44,F61,Q61,F83,Q83....
画像名を参照するセルは、常に画像位置のセルから左に1進んだもの右3文字と、左に1、下に2つ進んだものの数値になります。
(F5の場合、D5の右3文字,D7の数値)

組んでいただいたものは非常に見やすく、勉強になりました。
今から自分でもこれをもとに作ってみます
ありがとうございます。
とは言いましてもおそらく詰まってしまうのでまたお時間あればご連絡いただけると幸いです。

・ツリー全体表示


	【78731】Re:ファルダ内の画像を任意のセルに貼り...

β - 17/1/10(火) 20:33 -


	引用なし

	パスワード

▼VBA勉強中さん：

まだ、ちょっとわかりにくいところもありますがたたき台。
★のところ、シート名とフォルダは実際のものにしてください。

Sub Test()
　　Dim Pos As Range
　　Dim fPath As String
　　Dim fName As String
　　Dim Target As Range
　　Dim dic As Object
　　
　　With Sheets("Sheet1")　 '★対象シート
　　　　.Pictures.Delete
　　　　Set Pos = Sheets("Sheet1").Range("D5")
　　End With
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\画像フォルダ\"　'★
　　
　　Do While Not IsEmpty(Pos)
　　　　fName = Right(Pos.Value, 3) & Pos.Offset(2).Value & ".jpg"
　　　　fName = Dir(fPath & fName)
　　　　If fName <> "" Then
　　　　　　If Not dic.exists(fName) Then
　　　　　　　　dic(fName) = True
　　　　　　　　Set Target = Pos.Offset(, 1)
　　　　　　　　With ActiveSheet.Shapes.AddPicture(Filename:=fPath & fName, LinkToFile:=False, _
　　　　　　　　　　SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
　　　　　　　　　　Width:=-1, Height:=-1)　　　'-1 元の大きさで貼り付け
　　　　　　　　　　'===============タテヨコの縮尺を保持して拡大または縮小
　　　　　　　　　　.LockAspectRatio = True　　 '縦横比率の維持（念のため）
　　　　　　　　　　.Width = Target.Width * 0.9
　　　　　　　　　　If .Height > Target.Height * 0.9 Then .Height = Target.Height * 0.9
　　　　　　　　　　'===============中央へ調整
　　　　　　　　　　.Top = Target.Top + Target.Height / 2 - .Height / 2
　　　　　　　　　　.Left = Target.Left + Target.Width / 2 - .Width / 2
　　　　　　　　End With
　　　　　　End If
　　　　End If
　　　　Set Pos = Pos.Offset(, 11)
　　Loop
　　
End Sub

・ツリー全体表示


	【78730】Re:ファルダ内の画像を任意のセルに貼り...

VBA勉強中

- 17/1/10(火) 20:07 -


	引用なし

	パスワード

▼β さん：
投稿ありがとうございます！説明が焦りで雑になってしまっていました。すみません

>>A や B とは　セルにある数字で、その２つの数字から A-B を求め、その数字が画像ファイル名ということですか？
>
これについてですが、A-BはAを含むセルが[abc002]、Bを含むセルは[2]とした場合、A-Bは[002-2]ということになります。「AマイナスB」ではないです、わかりずらく申し訳ないです。

>もし、そうであれば、
>
>>また、この作業を"画像フォルダ"の写真が重複なくすべて使われるまで行いたいです。
>
>画像フォルダにいくつの画像がいるがあるのかわかりませんが、すべて使われるまでといっても
>A-B の計算結果に合致したい数字の画像ファイルは限られていますので、逆にいえば
>使われない画像ファイルもあるということではないですか？？

こちらですが、画像の名前は1-1~n-5程度までありまして、すべてを使用します。
画像の数は任意で変動します。
重複の件ですが、1-1が2つできてしまった場合エラーがでるようにしたい、という意図です。また拡張子ですがjpgのみになります。

非常に読みにくい文になってしまい申し訳ありません。よろしくおねがいします。

・ツリー全体表示


	【78729】Re:ファルダ内の画像を任意のセルに貼り...

β - 17/1/10(火) 19:45 -


	引用なし

	パスワード

▼VBA勉強中さん：

もう１つ。

画像ファイルの拡張子は何ですか？
jpg とか png とか。

・ツリー全体表示


	【78728】Re:ファルダ内の画像を任意のセルに貼り...

β - 17/1/10(火) 19:36 -


	引用なし

	パスワード

▼VBA勉強中さん：

あぁ、 A や B は　数字ではなく　文字列ですね。
でも、提示した疑問は同様ですので説明よろしく。

さらに、

>"画像フォルダ"の写真が重複なくすべて使われるまで行いたいです。

重複なく　というところが、何を意味するのかわかりません。

・ツリー全体表示


	【78727】Re:ファルダ内の画像を任意のセルに貼り...

β - 17/1/10(火) 19:30 -


	引用なし

	パスワード

▼VBA勉強中さん：

>A-Bという名前の画像を探す(画像はひとまとめにして"画像フォルダ"に入れています)

A や B とは　セルにある数字で、その２つの数字から A-B を求め、その数字が画像ファイル名ということですか？

もし、そうであれば、

>また、この作業を"画像フォルダ"の写真が重複なくすべて使われるまで行いたいです。

画像フォルダにいくつの画像がいるがあるのかわかりませんが、すべて使われるまでといっても
A-B の計算結果に合致したい数字の画像ファイルは限られていますので、逆にいえば
使われない画像ファイルもあるということではないですか？？

・ツリー全体表示


	【78726】ファルダ内の画像を任意のセルに貼り付け...

VBA勉強中 - 17/1/10(火) 17:11 -


	引用なし

	パスワード

質問です。
以下の手順のマクロを組みたいと考えています。
前提として、ひな形となるブックが存在し、それを開いている状態です。

sheet1のcells(5,4)の値の右3文字（Aとします）、cells(7,4)の値(Bとします)
A-Bという名前の画像を探す(画像はひとまとめにして"画像フォルダ"に入れています)
見つかった画像をsheet1.cells(5,6)に貼り付け、縦横比を保ちセル全体の約90%の大きさに縮尺し、セルの中央に揃える

その後参照するセルを、cells(5,4)をcells(5,15) cells(7,4)をcells(7,15)
貼り付け位置を、cells(5,17)に変更し同様の操作を行う

と言ったことをしたいです。
また、この作業を"画像フォルダ"の写真が重複なくすべて使われるまで行いたいです。

参照セルがこの後やや不規則になるのですが、for next構文で書いていく場合
セルの値に変数iを用いて例えば、cells(2*i+12,15)等、数列の一般項のような書き方をすることは可能でしょうか。
ご教授よろしくお願いします。shapeオブジェクトって言葉もつい先ほど知った程度のものです。柔らかく教えてもらえると幸いです。

・ツリー全体表示


	【78725】Re:重複を除いた出勤日数

γ - 16/12/31(土) 8:26 -


	引用なし

	パスワード

(基本方針）に従って質問の記載をしてください。
以下引用。

マルチポストについて
別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

====
解決したならその旨、報告いただきたい。

・ツリー全体表示


	【78724】重複を除いた出勤日数

ひさし

- 16/12/31(土) 0:51 -


	引用なし

	パスワード

excel の下記行データに於いて従業員・月毎の出勤日数をカウントするマクロを教えてください。
この時、日が"99"は除外する。

sumproductとcountifを組み合わせてできますか。

従業員番号、月、日、作業コード

例
1,12,1,001
1,12,2,002
1,12,99,123
1,12,2,003
1,12,2,001
1,12,15,001
2,12,3,001
この時1の12月の出勤日数3を求めたい

・ツリー全体表示


	【78723】Re:新しく取得したブックの名前について

VBA勉強２日目 - 16/12/28(水) 10:47 -


	引用なし

	パスワード

お2人に同時に返信する方法がわからなかったので同時宛先が1人になってしまいすみません。

Sub test()
　　Application.ScreenUpdating = False
Dim i
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　Workbooks.Add
　　ActiveWorkbook.SaveAs Workbooks("データ追加"). _
　　Worksheets("sheet1").Cells(i, "A").Value
　　ActiveWorkbook.Close False
Next

End Sub

これで無事、意図した通りに動きました。
ありがとうございます！

・ツリー全体表示


	【78722】Re:新しく取得したブックの名前について

VBA勉強２日目 - 16/12/28(水) 9:43 -


	引用なし

	パスワード

おはようございます

まずは１回のみの試行でやってみて繰り返しはその後、ということですね
今後も役に立つ思考をありがとうございます！

うまくできそうです

・ツリー全体表示


	【78721】Re:新しく取得したブックの名前について

VBA勉強２日目 - 16/12/28(水) 9:41 -


	引用なし

	パスワード

おはようございます。

重要そうなキーワードをありがとうございます！
そこから調べてやってみます

・ツリー全体表示


	【78720】Re:新しく取得したブックの名前について

マナ - 16/12/27(火) 22:40 -


	引用なし

	パスワード

▼VBA勉強２日目さん：
まずは、１つのブックを追加して保存するマクロを考えて下さい。
for～nextを使った繰り返しは、その後です。

１）新規ブックを追加
２）追加したブックをA1セルの名前で保存
３）追加したブックを閉じる

Sub test()
　　
　　Workbooks.Add
　　ActiveWorkbook.SaveAs ThisWorkbook.Worksheets("データ追加").Cells(1, "A").Value
　　ActiveWorkbook.Close False
　　
End Sub

・ツリー全体表示


	【78719】Re:新しく取得したブックの名前について

オムライス - 16/12/27(火) 17:42 -


	引用なし

	パスワード

こんにちは

ヒントだけですが。
作成したブックに「名前をつけて保存」をしたいのですよね。

それであれば、SaveAsメソッドを使うことになります。

・ツリー全体表示


	【78718】新しく取得したブックの名前について

VBA勉強２日目 - 16/12/27(火) 16:57 -


	引用なし

	パスワード

こんばんは、早速ですが質問です

新しくブックを作った後、cell(A,1)~(A,5)を参照してブックに名前をつけて保存をしたいのですが、
Sub bookad()
　　Application.ScreenUpdating = False
　　Dim i
　　For i = 1 To 5
　　　　Application.SheetsInNewWorkbook = 1
　　　　Workbooks.Add
　　　　Workbooks("データ追加").Activate
　　　　Sheets("データ追加").Cells(i, 2). _
　　　　Value = ActiveWorkbook.Name
　　Next
End Sub
途中ですが名前がうまくつきません、ご教授お願いいたします。

・ツリー全体表示


	【78717】Re:セルに入力されたら印刷

γ - 16/12/22(木) 0:51 -


	引用なし

	パスワード

>Private Sub Worksheet_Change(ByVal Target As Range)を２つ利用しているため
>エラーになります回避方法ありますか。

同じ質問を何度もしないようにしてください。

ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=78439;id=excel
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=78472;id=excel

・ツリー全体表示


	【78716】Re:セルに入力されたら印刷

北風 - 16/12/21(水) 17:58 -


	引用なし

	パスワード

▼β さん：
>▼北風さん：
>
>１つのモジュールに同じ名前のプロシジャを書くことはできません。
>現在のものと、アップしたものが共存できるように組み立てることが必要です。
>現在のものを、そのまま、コピペでアップしてください。

β さん：
有難うございます。
頑張ってやってみます

・ツリー全体表示


	【78715】Re:ペーストのVBA

初心 - 16/12/21(水) 16:24 -


	引用なし

	パスワード

▼β さん：
うわー！！！！ありがとうございます！！！！
教えていだたいたコードでできました！　今回とても勉強になりました。
奥が深いですね。もっともっと勉強していきたいと思います！

>▼初心さん：
>
>このメッセージが出るということは wsInvoiceシートの２１行目から下に
>結合セルがあるということです。
>
>よく調べてみてください。
>
>なお、処理後、F列をクリアしているということは、次回処理する際には
>1 がたっていないわけですから、必ず　1 をつけてから操作する必要がありますね。
>
>まぁ、それはともあれ、アップされたコードでやろうとしていることを継承して
>コード記述をかえてみました。参考までに。
>（それでも、結合セルがあれば、これもエラーになります）
>
>★印のところは実際のシート名にしてください。
>
>Sub Sample()
>　　Dim wsData As Worksheet
>　　Dim wsInvoice As Worksheet
>　　
>　　Set wsData = Sheets("Sheet1")　　　 '★
>　　Set wsInvoice = Sheets("Sheet2")　　'★
>　　
>　　wsInvoice.Range("A1", wsInvoice.UsedRange).Columns("A:H").Offset(20).ClearContents
>　　wsData.AutoFilterMode = False '念のためいったんリセット
>　　
>　　wsData.Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="1"
>　　wsData.AutoFilter.Range.Copy wsInvoice.Range("A21")
>　　
>　　On Error Resume Next
>　　wsData.ShowAllData
>　　On Error GoTo 0
>　　
>　　wsData.AutoFilter.Range.Columns("F").Offset(1).ClearContents
>　　　　
>　　wsInvoice.Select
>　　
>End Sub

・ツリー全体表示


	【78714】Re:ペーストのVBA

β - 16/12/21(水) 14:58 -


	引用なし

	パスワード

▼初心さん：

このメッセージが出るということは wsInvoiceシートの２１行目から下に
結合セルがあるということです。

よく調べてみてください。

なお、処理後、F列をクリアしているということは、次回処理する際には
1 がたっていないわけですから、必ず　1 をつけてから操作する必要がありますね。

まぁ、それはともあれ、アップされたコードでやろうとしていることを継承して
コード記述をかえてみました。参考までに。
（それでも、結合セルがあれば、これもエラーになります）

★印のところは実際のシート名にしてください。

Sub Sample()
　　Dim wsData As Worksheet
　　Dim wsInvoice As Worksheet
　　
　　Set wsData = Sheets("Sheet1")　　　 '★
　　Set wsInvoice = Sheets("Sheet2")　　'★
　　
　　wsInvoice.Range("A1", wsInvoice.UsedRange).Columns("A:H").Offset(20).ClearContents
　　wsData.AutoFilterMode = False '念のためいったんリセット
　　
　　wsData.Range("A1").CurrentRegion.AutoFilter Field:=6, Criteria1:="1"
　　wsData.AutoFilter.Range.Copy wsInvoice.Range("A21")
　　
　　On Error Resume Next
　　wsData.ShowAllData
　　On Error GoTo 0
　　
　　wsData.AutoFilter.Range.Columns("F").Offset(1).ClearContents
　　　　
　　wsInvoice.Select
　　
End Sub

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

186 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free