Excel VBA質問箱 IV

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

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


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

302 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76388】Re:メール新規作成画面　CC欄へ表示

ゆき - 14/11/13(木) 9:41 -


	引用なし

	パスワード

▼カリーニンさん：
サイトを教えていただきありがとうございました。
勉強しながらやってみたいと思います。

>メーラーは何ですか？
>
>OUTLOOKならエクセルVBAやOUTLOOK VBAで制御できます。
>
>また、CDOを使う、というてもあります。
>
>ht tp://excel-ubara.com/excelvba4/EXCEL233.html
>
>ちょっと古い記事のようですのでバージョン等は最近の
>ものに置き換えて読んでください。
>また、最近のバージョンで使えるかは私自身未検証です。

・ツリー全体表示


	【76387】Re:メール新規作成画面　CC欄へ表示

γ - 14/11/12(水) 21:29 -


	引用なし

	パスワード

なにか、アンパサンドの次にセミコロンが入る仕様のようですが、
セミコロンは不要です。脳内変換して下さい。

・ツリー全体表示


	【76386】Re:メール新規作成画面　CC欄へ表示

γ - 14/11/12(水) 20:54 -


	引用なし

	パスワード

xlDialogSendMailの引数は recipients、subject、return_receipt であるとヘルプに書かれているので、たぶんCC:はセットできないでしょう。シートにハイパーリンクを張って、それをクリックしてはどうですか？ Sub test() 　　ActiveSheet.Hyperlinks.Add _ 　　Anchor:=Selection, _ 　　Address:="mailto:aaa@xxx.xx.xx&;cc=bbb@xxx.xx.xx&;Subject=title&body=本文", _ 　　TextToDisplay:="セルに表示する文字列" End Sub こうしておけば、固定の相手への定期的なメールには使えます。ただし添付ファイルを自動でつけることはできませんが。本格的にするなら、既にご指摘のとおりの手法がありますが、まったくの初心者なら、OutlookとかCDOとかの操作は、もっと先の課題でしょう。 # 情報提供になんら異論を挟むつもりはありませんし、 #「まったくの初心者」などというのは幅のある言葉と承知していますが。

・ツリー全体表示


	【76385】Re:メール新規作成画面　CC欄へ表示

カリーニン - 14/11/12(水) 19:32 -


	引用なし

	パスワード

メーラーは何ですか？

OUTLOOKならエクセルVBAやOUTLOOK VBAで制御できます。

また、CDOを使う、というてもあります。

ht tp://excel-ubara.com/excelvba4/EXCEL233.html

ちょっと古い記事のようですのでバージョン等は最近の
ものに置き換えて読んでください。
また、最近のバージョンで使えるかは私自身未検証です。

・ツリー全体表示


	【76384】メール新規作成画面　CC欄へ表示

ゆき - 14/11/12(水) 14:14 -


	引用なし

	パスワード

はじめまして。
VBA全くの初心者です。

現在下記のようなコードを使用し、申込ボタンをクリックすると
新規メール画面が立ち上がり、宛先欄にアドレスが表示され、
同時に件名も表示されている状態です。
これだと全部のアドレスが宛先欄に表示されているので、
CC欄にも表示させたい（例えばアドレス5.と6.）と思っているのですが、
方法がわかりません。
どなたか分かる方がいらっしゃいましたらお願いいたします。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton1_Click()

Dim adr As String
　　Const adr1 As String = "アドレス1."
　　Const adr2 As String = "アドレス2."
　　Const adr3 As String = "アドレス3."
　　Const adr4 As String = "アドレス4."
　　Const adr5 As String = "アドレス5."
　　Const adr6 As String = "アドレス6."
　　　　
　　Application.Dialogs(xlDialogSendMail).Show Array(adr1, adr2, adr3, adr4, adr5, adr6), "切手・収入印紙申込"

End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

・ツリー全体表示


	【76383】Re:［無題］

γ - 14/11/12(水) 6:13 -


	引用なし

	パスワード

▼ペンネーム船長さん：
>でも、なぜ、始めの私のコードではシートをSelect出来なかったのでしょうか。
逆にお尋ねしますが、コードのどこでシートをSelectしていますか？

以下、想像で書きます。違っていたら失礼。
For Each sh In Worksheets
　　sh.Cells(1,1).Value = 1
Next
というコードがあったとき、
「人間がそれを手作業でやる」イメージを持たれていませんか？

まず、最初のシートを開いて、
そのA1セルに、1を入れる。
次に、2番目のシートを開いて・・・

人間がやるなら、シートを次々に開いていかないと、セルに入力できません。
しかし、それはとても無駄なわけです。
選択しなくても、
　　sh.Cells(1,1).Value = 1
で可能なんです。可能だし、そうすべきなんです。

しかも、うっかり
For Each sh In Worksheets
　　sh.Cells(1,1).Select
　　Selection.Value = 1
Next
と書いてしまったら、そこでアウト。ゲームセット。それはエラーになるのです。
理由はもうおわかりでしょう。

------------------------------------
「VBA高速化テクニック」
ht tp://officetanaka.net/excel/vba/speed/index.htm
のなかの
「無駄なSelectをしない」
ht tp://officetanaka.net/excel/vba/speed/s2.htm
を参考にして下さい。
「VBA高速化テクニック」も熟読されるとよいでしょう。

そこでは主として処理速度に重点を置いて書かれていますが、
可読性の向上の観点からも、「Selectするな」が推奨されます。

例外的な場合を除いて、Selectを使う必要はありません。
書いたらエラーになることが多い。
今回と、【76344】取り消し線が引けない(14/11/1(土) 21:29 )　
がその例です。
百害あって一利なし、です。

ベテランさんのようにお見受けしますので、
Selectを簡単に使ってしまう癖から、
早く卒業していただきたいと思います。

# 失礼がありましたら、お許し願います。

・ツリー全体表示


	【76382】Re:［無題］

ペンネーム船長 - 14/11/12(水) 0:15 -


	引用なし

	パスワード

▼γ さん：
ご返事遅れてスミマセン。
今朝、前回のアドバイスに書き換えて会社で動かしてみたら、上手く罫線を引くことが出来ました。
ここに挙げたコードは一部だったので、商品1や商品2、商品3が無かったときの処置は他のところで処理しております。

>繰り返しますが、シートが選択されていない状態で、セルを直接選択することは
>できません。
このアドバイスが解決の鍵となりました。
でも、なぜ、始めの私のコードではシートをSelect出来なかったのでしょうか。
もし、宜しかったらこのあたりの説明をお願いします。

・ツリー全体表示


	【76381】Re:［無題］

γ - 14/11/11(火) 22:38 -


	引用なし

	パスワード

商品2,商品3の有無チェックが必要かもしれないが、
一応、修正版を載せておきます。

Private Sub CommandButton1_Click()

　　Dim buf As String
　　Dim wb As Workbook
　　Dim K As String　　'管理記号用変数
　　Dim sh As Worksheet
　　Dim obj As Range
　　Dim obj2 As Range
　　Dim w As String
　　Dim n As Integer
　　Dim n2 As Integer

　　K = ThisWorkbook.Worksheets("ツール").Range("B6").Value　'管理記号があるセル

　　Const path = "C:\Users\●○\Desktop\test\"
　　buf = Dir(path & "\*商品一覧表" & K & "*.xls")
　　Set wb = Workbooks.Open(path & buf)

　　For Each sh In Worksheets
　　　　Set obj = sh.Cells.Find(what:="商品1", LookIn:=xlValues, _
　　　　　　　　　lookat:=xlWhole, MatchCase:=False, MatchByte:=False)　 '1回目の検索
　　　　If Not obj Is Nothing Then　'『商品1』があったとき
　　　　　　w = obj.Offset(0, 7).Value　　 'Ｋ列（階数）
　　　　　　n = obj.Offset(0, 3).Value　　 'Ｇ列（数量）
　　　　　　obj.Offset(0, 4).Value = "▲" & n
　　　　　　obj.Offset(0, 5).Value = "0"
　　　　　　obj.Offset(0, -3).Value = "○"
　　　　　　obj.Offset(0, 3).Font.Strikethrough = True　　'取り消し線を引く

　　　　　　'*****検索出来た行に太線を引きたい*****
　　　　　　With sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Borders(xlEdgeBottom)
　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　.Weight = xlMedium
　　　　　　End With

　　　　　　If w = "1" Then　'商品1が1階にあるとき
　　　　　　　　Set obj2 = sh.Cells.Find(what:="商品2", LookIn:=xlValues, _
　　　　　　　　　　lookat:=xlWhole, MatchCase:=False, MatchByte:=False)　'続けて2回目の検索
　　　　　　　　n2 = obj2.Offset(0, 3).Value　 'Ｇ列（数量）
　　　　　　　　obj2.Offset(0, 4).Value = "＋" & n
　　　　　　　　obj2.Offset(0, 5).Value = n2 + n
　　　　　　　　obj2.Offset(0, -3).Value = "○"
　　　　　　　　obj2.Offset(0, 3).Font.Strikethrough = True　　'取り消し線を引く

　　　　　　　　'*****検索出来た行に太線を引きたい*****
　　　　　　　　With sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Borders(xlEdgeBottom)
　　　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　　　.Weight = xlMedium
　　　　　　　　End With
　　　　　　End If

　　　　　　If w = "2" Or w = "3" Or w = "4" Or w = "5" Or w = "6" Then　
　　　　　　　　Set obj2 = sh.Cells.Find(what:="商品3", LookIn:=xlValues, _
　　　　　　　　　　lookat:=xlWhole, MatchCase:=False, MatchByte:=False)
　　　　　　　　n2 = obj2.Offset(0, 3).Value　 'Ｇ列（数量）
　　　　　　　　obj2.Offset(0, 4).Value = "＋" & n
　　　　　　　　obj2.Offset(0, 5).Value = n2 + n
　　　　　　　　obj2.Offset(0, -3).Value = "○"
　　　　　　　　obj2.Offset(0, 3).Font.Strikethrough = True　　'取り消し線を引く

　　　　　　　　'*****検索出来た行に太線を引きたい*****
　　　　　　　　With sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Borders(xlEdgeBottom)
　　　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　　　.Weight = xlMedium
　　　　　　　　End With
　　　　　　End If
　　　　End If
　　　　w = ""
　　　　n = 0
　　　　n2 = 0
　　Next sh
End Sub
繰り返しますが、シートが選択されていない状態で、セルを直接選択することは
できません。

・ツリー全体表示


	【76380】Re:エラー値がある場合にもグラフの「近...

γ - 14/11/10(月) 22:17 -


	引用なし

	パスワード

># グラフを描き、近似曲線を引いて計算される内部データのポインタに
># ワークシート関数でアクセスする方法があれば良いのですが...
昔(たぶんExcel2003くらいまで？）は、
ht tp://www2.aqua-r.tepm.jp/~kmado/ke_m6.htm#E97M054
のような方法で、近似式の係数を取得することができたのですが、
手元の2010ではエラーになりますね。
残念です。（念のため、そちらでも確認して下さい）

今の方針でいいんじゃないですかね。
多項式の場合は、x^n の項をそれぞれ独立の変数と思えば、
線形近似の手法が使えるはずです。

・ツリー全体表示


	【76379】Re:エラー値がある場合にもグラフの「近...

htnk - 14/11/10(月) 21:45 -


	引用なし

	パスワード

不明瞭な投稿にて失礼いたしました。

ここでは、グラフの「近似曲線」のように、空欄や #N/A があっても
答えを示せる (エラー値を返さない) ことを「最強」と定義させてください。

# グラフを描き、近似曲線を引いて計算される内部データのポインタに
# ワークシート関数でアクセスする方法があれば良いのですが...

・ツリー全体表示


	【76378】Re:「サブフォルダ内ファイルのプロパテ...

渡辺真 - 14/11/10(月) 10:52 -


	引用なし

	パスワード

とりあえず動きそうなものを作ったので、ご参考までに。指定フォルダの全てのファイルのプロパティを出力(サブ・フォルダ以下も含む) makoto-watanabe.main.jp/vba_file3.html#FilePropertyIncludeSubfolders オブジェクトを使ったマクロは、難しいですね。

・ツリー全体表示


	【76377】Re:［無題］

γ - 14/11/10(月) 7:06 -


	引用なし

	パスワード

> sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Select 'エラーが出る
> With Selection.Borders(xlEdgeBottom)
> 　　.LineStyle = xlContinuous
> 　　.Weight = xlMedium
> End With
Selectは使わずに、↓のようにしては？
With sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Borders(xlEdgeBottom)
　　.LineStyle = xlContinuous
　　.Weight = xlMedium
End With

・ツリー全体表示


	【76376】Re:［無題］

γ - 14/11/10(月) 0:10 -


	引用なし

	パスワード

全てを読んでいるわけではなく恐縮です。
sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Select　'エラーが出る
objはどの列にあるかデバッグしましょう。
仮にA列とすると、左に３つ行ったところは？

・ツリー全体表示


	【76375】［無題］

ペンネーム船長 - 14/11/9(日) 23:57 -


	引用なし

	パスワード

お世話になります。
『商品一覧表K（管理記号）.xls』というブックのシートに『商品1』があったとき、その行の先頭に○を付けるなど加工し、その行に太線を引きたいのですが、下記のところでエラーが出てしまいます。
先頭に○を付けたり数量に取り消し線を引いたり、数量を増減したりする事は正常に動くのですが、太線を引く事が出来ません。
間違いを教えてくれますでしょうか。
エラーは、実行時エラー1004/RangeクラスのSelectメソッドが失敗しました。です。
宜しくお願いします。

'状況：マクロのあるブックの他に『商品一覧表K（管理記号）.xls』というブックが立ち上がっています。
Private Sub CommandButton1_Click()

Dim buf As String
Dim wb As Workbook
Dim K As String '管理記号用変数
Dim sh As Worksheet
Dim obj As Range
Dim obj2 As Range
Dim w As String
Dim n As Integer
Dim n2 As Integer

K = ThisWorkbook.Worksheets("ツール").Range("B6").Value　'管理記号があるセル

Const path = "C:\Users\●○\Desktop\test\"
buf = Dir(path & "\*商品一覧表" & K & "*.xls")
Set wb = Workbooks.Open(path & buf)

For Each sh In Worksheets
　　　　　
　　Set obj = sh.Cells.Find(what:="商品1", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, MatchByte:=False)　 '1回目の検索

　　If Not obj Is Nothing Then　'『商品1』があったとき
　　　　
　　　　w = obj.Offset(0, 7).Value　　 'Ｋ列（階数）
　　　　n = obj.Offset(0, 3).Value　　 'Ｇ列（数量）
　　　　obj.Offset(0, 4).Value = "▲" & n
　　　　obj.Offset(0, 5).Value = "0"
　　　　obj.Offset(0, -3).Value = "○"
　　　　obj.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
　　　　
　　　 '*****検索出来た行に太線を引きたい*****
　　　　sh.Range(obj.Offset(0, -3), obj.Offset(0, 10)).Select 'エラーが出る
　　　　With Selection.Borders(xlEdgeBottom)
　　　　　.LineStyle = xlContinuous
　　　　　.Weight = xlMedium
　　　　End With
　　
　　　　If w = "1" Then　'商品1が1階にあるとき
　　　　　　　　Set obj2 = sh.Cells.Find(what:="商品2", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, MatchByte:=False)　'続けて2回目の検索
　　　　　　　　n2 = obj2.Offset(0, 3).Value　 'Ｇ列（数量）
　　　　　　　　obj2.Offset(0, 4).Value = "＋" & n
　　　　　　　　obj2.Offset(0, 5).Value = n2 + n
　　　　　　　　obj2.Offset(0, -3).Value = "○"
　　　　　　　　obj2.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
　　　　　　　　
　　　　　　　'*****検索出来た行に太線を引きたい*****
　　　　　　　 sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Select　'エラーが出る
　　　　　　　　　 With Selection.Borders(xlEdgeBottom)
　　　　　　　　 .LineStyle = xlContinuous
　　　　　　　　 .Weight = xlMedium
　　　　　　　 End With
　　　　End If
　　　　
　　　　If w = "2" Or w = "3" Or w = "4" Or w = "5" Or w = "6" Then　'商品1が2階～6階にあるとき
　　　　　　　　Set obj2 = sh.Cells.Find(what:="商品3", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, MatchByte:=False)　'続けて2回目の検索
　　　　　　　　n2 = obj2.Offset(0, 3).Value　 'Ｇ列（数量）
　　　　　　　　obj2.Offset(0, 4).Value = "＋" & n
　　　　　　　　obj2.Offset(0, 5).Value = n2 + n
　　　　　　　　obj2.Offset(0, -3).Value = "○"
　　　　　　　　obj2.Offset(0, 3).Font.Strikethrough = True '取り消し線を引く
　　　　　　
　　　　　　　 '*****検索出来た行に太線を引きたい*****
　　　　　　　　sh.Range(obj2.Offset(0, -3), obj2.Offset(0, 10)).Select　’エラーが出る　　　　　　　　　　　　　With Selection.Borders(xlEdgeBottom)
　　　　　　　　 .LineStyle = xlContinuous
　　　　　　　　 .Weight = xlMedium
　　　　　　　 End With
　　　　End If
　　End If
　　w = ""
　　n = 0
　　n2 = 0
Next sh

End Sub

・ツリー全体表示


	【76374】Re:エラー値がある場合にもグラフの「近...

γ - 14/11/9(日) 23:57 -


	引用なし

	パスワード

あなたが望むような回答でなくて失礼します。

>なんとか最強の方法に辿り着きたい
何をもって最強とおっしゃっているのか、具体的に明確にして下さい。
空白やエラー値などの値があったとき、
どのようにしたいのかも明確にして下さい。

・ツリー全体表示


	【76373】エラー値がある場合にもグラフの「近似曲...

htnk - 14/11/9(日) 23:27 -


	引用なし

	パスワード

エラー値がある場合にもグラフの「近似曲線」と同様の動作をする関数、または関数でなくても係数を得る方法はありませんでしょうか。グラフの「近似曲線」機能を使用して表示される近似式の係数を、セルで扱いたいと思っています。色々な方法を試しましたが、エラー値がある場合にも「近似曲線」機能と同じ動作をしてもらえる方法を見付けることが出来ませんでした。近似式の関数としては、y=ax+b をはじめ多項式、y=ax^b、y=ae^x 等を想定しています。ジャンルは統計というよりは、科学技術実験系です。ここに、調べた方法とエラー値がある場合の結果をまとめました。なんとか最強の方法に辿り着きたいと思いますのでお助け下さい。方法　　　　 | 空欄or文字列 | #N/A　　| #NUM!　 | #DIV/0! | #VALUE! | 備考 -------------------------------------------------------------------------------- 「近似曲線」 | ok　　　　　 | ok　　　| 0扱い　 | 0扱い　 | 0扱い　 | 最強 slope()　　　| ok　　　　　 | #N/A　　| #NUM!　 | #DIV/0! | #VALUE! | 多項式非対応 intercept()　| ok　　　　　 | #N/A　　| #NUM!　 | #DIV/0! | #VALUE! | 同上 rsq()　　　　| ok　　　　　 | #N/A　　| #NUM!　 | #DIV/0! | #VALUE! | 同上 forecast()　 | ok　　　　　 | #N/A　　| #NUM!　 | #DIV/0! | #VALUE! | 同上 linest()　　 | #VALUE!　　 | #VALUE! | #VALUE! | #VALUE! | #VALUE! | 最弱 trend()　　　| #VALUE!　　 | #VALUE! | #VALUE! | #VALUE! | #VALUE! | 同上現在のところ、妥協を重ねて以下のようなことをしています。【y=ax+b の場合】　　a = slope( y , x )　b = intercept( y , x ) 【y=ax^b の場合】　　a = exp(intercept( ln(y)を計算したセル , ln(x)を計算したセル ) 　　b = slope( ln(y)を計算したセル , ln(x)を計算したセル ) 　　※ ln(y) を計算したセルとは、 =if(isna(y), "", ln(y)) を計算したセル。　　※ 一気に a = exp(intercept( ln(y) , ln(x) ) と書くと、　　　　ln(空欄)がエラーになるため intercept() もエラーになってしまう。【多項式の場合】　　諦めて linest を使い、空欄がある場合は時間をかけて手作業で対応する。

・ツリー全体表示


	【76372】Re:シート名の代入について

コーヒー - 14/11/7(金) 18:32 -


	引用なし

	パスワード

出来ました！
ありがとうございます（*^_^*）

・ツリー全体表示


	【76371】Re:シート名の代入について

独覚 - 14/11/7(金) 17:05 -


	引用なし

	パスワード

▼コーヒーさん：
Sheets(●●)
を
ActiveSheet
にしてはどうでしょうか？

・ツリー全体表示


	【76370】Re:webbrowserコントロール

nanashi - 14/11/7(金) 16:15 -


	引用なし

	パスワード

イベント発火させるだけならもっと単純でよかった。

クラスモジュール(ClassModule)
　Private Sub Class_Initialize()
　　If Application.ShowWindowsInTaskbar Then
　　　　Application.ShowWindowsInTaskbar = False
　　　　Application.ShowWindowsInTaskbar = True
　　End If
　End Sub

WebBrowserControl で Navigate した後に
　'(Dim DummyClass As ClassModule)
　Set DummyClass = New ClassModule
　Set DummyClass = Nothing
するだけでOK。

バージョンチェックしていたのは Excel2013 だと SDI だからっぽい。
情報元はここでした（感謝）。ｈｔｔｐ： //xlsm.web.fc2.com/sp9/excel_taskbar.html

・ツリー全体表示


	【76369】シート名の代入について

コーヒー - 14/11/7(金) 16:01 -


	引用なし

	パスワード

こんにちは。
シート上のボタンクリックすると指定範囲のデータが削除される
設定をしているのですが、シートが1202、1213、1219などと
シートコピーをしてゆく予定です。その度にシート名を書き換えることなく、
Sheets(●●).Range("F4:Q28").ClearContentsのように、
●●一つで代入することは可能でしょうか。

ご教授をお願いいたします。

Private Sub CmdClear_Click()

Dim Kakunin As Integer
　　
　　Kakunin = MsgBox("■を全て削除していいですか？", vbYesNo)
　　If Kakunin = vbYes Then
　　
　　Sheets("1201").Range("F4:Q28").ClearContents←この部分
　　Sheets("1201").Range("U4:AF28").ClearContents←この部分
　　
　　Else
　　　　Cancel = True
　　End If

・ツリー全体表示


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

302 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free