Excel VBA質問箱 IV

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

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


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

173 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79010】チェックボックスがONの場合に選択してい...

ペーターパン - 17/4/14(金) 12:07 -


	引用なし

	パスワード

■相談内容
　チェックボックスにより下記の機能のON、OFFを切り替えたいです。

　　・チェックが入っている　：選択している行の文字を太く表示する
　　・チェックが入っていない：選択している行の表示はそのまま

　一度、下記のような流れで作成を試みたのですがうまくいきませんでした。
　ぜひアドバイスお願い致します。

■作ろうとしたVBAのソース

　Private Sub checkbox1_click(ByVal Target As Range)
　　　With ActiveSheet.CheckBoxes(Application.Caller)
　　　　　If .Value = xlOn Then
　　　　　　UsedRange.Font.Bold = False
　　　　　　Rows(Target.Row).Font.Bold = True
　　　　　End If
　　　End With
　End Sub

・ツリー全体表示


	【79009】Re:next に対応するforが無い

マナ - 17/4/13(木) 22:47 -


	引用なし

	パスワード

▼わたるさん：
もう見ていないと思いますが

逐一、シートを選択しない書き方をお勧めします。

頑張って考えたコードかもしれませんが
わかりにくかったので書き換えてみました。

Sub test()
　　Dim r As Range
　　Dim i As Long
　　Dim n As Long
　　
　　Set r = Sheets("明細票").Range("C2:C5")
　　
　　Set r = Union(r, r.Offset(, 4), r.Offset(, 8))
　　Set r = Union(r, r.Offset(7), r.Offset(14))
　　r.ClearContents

　　With Sheets("俺")
　　　　For i = 21 To 35
　　　　　　If .Cells(i, "V").Value <> "" Then
　　　　　　　　n = n + 1
　　　　　　　　r.Areas(n)(1).Value = .Cells(i, "B").Value
　　　　　　　　r.Areas(n)(2).Value = .Cells(i, "G").Value
　　　　　　　　r.Areas(n)(3).Value = .Cells(i, "I").Value
　　　　　　　　r.Areas(n)(4).Value = .Cells(i, "R").Value
　　　　　　End If
　　　　Next
　　End With
　　
End Sub

・ツリー全体表示


	【79008】Re:等間隔の行数取得

γ - 17/4/13(木) 21:02 -


	引用なし

	パスワード

>For row2 = 7 To maxrow2
>　　If sh1.Cells(row2, "K").Value = "あああ" Then
>　　　 ttlrow2 = row2
>　　Exit For
>　　End If
>Next
のところですが、
"あああ"がひとつ見つかったら
Exit Forでループを脱出しています。
これはあなたの意図と整合していますか？

Exit For　をやめて、そこで、その都度、２や３の処理をしたらよいのでは？
dictionaryの内容が説明されていないので、
あなたが何をしたいのか、皆さんに伝わりませんが・・・

・ツリー全体表示


	【79007】等間隔の行数取得

boss - 17/4/13(木) 19:43 -


	引用なし

	パスワード

K13、K20、K27・・・、と等間隔で「あああ」と入力されている行数を取得
して下記1.2.のようにしたいのですが、1.にてK20以降がうまく取得できません。
お手数ですがご教授の程よろしくお願いいたします。
　1.ttlrow2に行数を取得
　2.にてdict(key)の値をセット
　3.TからNTの範囲で、ttlrow2の行に罫線をひく

=========================
'1.
maxrow2 = sh1.Cells(Rows.Count, "K").End(xlDown).row
For row2 = 7 To maxrow2
　　If sh1.Cells(row2, "K").Value = "あああ" Then
　　　 ttlrow2 = row2
　　Exit For
　　End If
Next

If ttlrow2 = 0 Then
　　MsgBox ("あああ行がありません" & vbLf & "処理を打ち切ります")
　　Exit Sub
End If

'2.
sh1.Cells(ttlrow2, tcol).Value = dicT(key)

'3.
sh1.Cells(ttlrow2, tcol).Borders(xlEdgeBottom).LineStyle = xlThick
=========================

・ツリー全体表示


	【79006】Re:next に対応するforが無い

わたる - 17/4/11(火) 12:31 -


	引用なし

	パスワード

▼γ さん：
>> 　If Cells(sgyou_lngRow, 22).Value <> "" Then
>に対応する End If が脱漏しているのではないですか？
>
>内容は見ておりません。

早速の解答ありがとうございます。
ご指摘の通り脱漏していました。あれこれやっている内に消してしまったようです。その事に気付かず質問してしまい心苦しい次第です。
ありがとうございました。

・ツリー全体表示


	【79005】エクセルへの写真画像の貼り付け

ひでとし

- 17/4/10(月) 21:34 -


	引用なし

	パスワード

エクセルのセルでダブルクリックすると、画像を選び、セルにぴったり収まるように一番大きく貼り付けます。デジカメで撮った画像は、ぴったりに収まりません。やや小さくなります。オリジナル画像をペイントで呼び出してそのまま上書き保存をすると、今度はその画像はぴったり収まります。VBAに問題があるのか教えて下さい。

VBA
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
　　　　　　　　　　　　　　　　　　　　Cancel As Boolean)
　　Dim PicFile As Variant
　　Dim rX As Double, rY As Double

　　'［ファイルを開く］ダイアログボックスを表示
　　　 PicFile = Application.GetOpenFilename( _
　　　　　　　　　　　　"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp")
　　If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub

　　Application.ScreenUpdating = False
　　
　　'画像を挿入
　　With ActiveSheet.Pictures.Insert(PicFile)
　　　　rX = Target.Height / Target.Width
　　　　rY = .Height / .Width
　　　　If rX > rY Then
　　　　　　　 .Width = Target.Width
　　　　Else
　　　　　　　.Height = Target.Height
　　　　End If

　　'セルの中央（横方向/縦方向の中央）に配置
　　　　.Left = Target.Left + (Target.Width - .Width) / 2
　　　　.Top = Target.Top + (Target.Height - .Height) / 2
　　End With
　　
　　Application.ScreenUpdating = True
　　Cancel = True
End Sub

・ツリー全体表示


	【79004】Re:next に対応するforが無い

γ - 17/4/10(月) 21:01 -


	引用なし

	パスワード

> 　If Cells(sgyou_lngRow, 22).Value <> "" Then
に対応する End If が脱漏しているのではないですか？

内容は見ておりません。

・ツリー全体表示


	【79003】next に対応するforが無い

わたる - 17/4/10(月) 20:31 -


	引用なし

	パスワード

シート”俺”の項目内容を一セルごとにコピーして
シート”明細表”の各セルにペーストし、俺が９項目に達したら
プリントしまた次の項目をコピペして最後は９項目に達しなくても
プリントする目的で作りました。（プリントの部分は割愛しています）
プリントまでは順調に動作していたのですが。突如題名の様なエラーに
なりました。
どこに問題があるのか思い当る箇所は訂正したのですが改善に至りません
どこに問題があるかお分かりになる方がいらっしゃいましたらご指導をお願い
致します

Sub mpri2()
' m_pri Macro
'定義
　Dim sgyou_lngRow As Integer '俺
　Dim sretu_lngRow As Integer
　
　Dim hyouji As String '保持
　Dim frg As Long
　Dim pfrg As Long

　Dim mgyou_lngRow As Integer '明細
　Dim mretu_lngRow As Integer
　
'初期値
　 '俺
　 sgyou_lngRow = 21
　 sretu_lngRow = 2
　
　 '明細
　 mgyou_lngRow = 2
　 mretu_lngRow = 3
　 '保持
　 frg = 0
　 pfrg = 0
'クリア
　　Sheets("明細票").Select
　　Range( _
　　　　"C2,C3,C4,C5,G2,G3,G4,G5,K2,K3,K4,K5,C9,C10,C11,C12,G9,G10,G11,G12,K9,K10,K11,K12,C16,C17,C18,C19,G16,G17,G18,G19,K16,K17,K18,K19").Select
　　Selection.ClearContents
　　hyouji = ""
'開始

For sgyou_lngRow = 21 To 35

　　Sheets("俺").Select
　　If Cells(sgyou_lngRow, 22).Value <> "" Then
　　　 hyouji = Cells(sgyou_lngRow, sretu_lngRow).Value
　　　 Sheets("明細票").Select
　　　 Cells(mgyou_lngRow, mretu_lngRow).Value = hyouji
　　　 Sheets("俺").Select
　　　 hyouji = ""
　　　
　　　 sretu_lngRow = sretu_lngRow + 5
　　　 hyouji = Cells(sgyou_lngRow, sretu_lngRow).Value
　　　 Sheets("明細票").Select
　　　 mgyou_lngRow = mgyou_lngRow + 1
　　　 Cells(mgyou_lngRow, mretu_lngRow).Value = hyouji
　　　 Sheets("俺").Select
　　　 hyouji = ""
　　　
　　　 sretu_lngRow = sretu_lngRow + 2
　　　　　　　hyouji = Cells(sgyou_lngRow, sretu_lngRow).Value
　　　 Sheets("明細票").Select
　　　 mgyou_lngRow = mgyou_lngRow + 1
　　　 Cells(mgyou_lngRow, mretu_lngRow).Value = hyouji
　　　 Sheets("俺").Select
　　　 hyouji = ""
　　　
　　　 sretu_lngRow = sretu_lngRow + 9
　　　 hyouji = Cells(sgyou_lngRow, sretu_lngRow).Value
　　　 Sheets("明細票").Select
　　　 mgyou_lngRow = mgyou_lngRow + 1
　　　 Cells(mgyou_lngRow, mretu_lngRow).Value = hyouji
　　　 Sheets("俺").Select
　　　 hyouji = ""

　　　 If frg = 0 Then
　　　　　　　　　mgyou_lngRow = 2
　　　　　 ElseIf frg = 1 Then
　　　　　　　　　mgyou_lngRow = 9
　　　　　 ElseIf frg = 2 Then
　　　　　　　　　mgyou_lngRow = 16
　　　 End If
　　　 sretu_lngRow = 2
　　　 mretu_lngRow = mretu_lngRow + 4
　　　 If mretu_lngRow > 11 Then
　　　　　mretu_lngRow = 3
　　　　　mgyou_lngRow = mgyou_lngRow + 7
　　　　　frg = frg + 1
　　　 End If
Next sgyou_lngRow
End Sub

・ツリー全体表示


	【79002】Re:最前面

ＴＷ - 17/4/5(水) 7:44 -


	引用なし

	パスワード

▼β さん

色々お手数をおかけしましたが　
参考コードを頂き、思うような動作ができました
お忙しいところお手数かけました、よろしくお願いいたします。

▼β さん：
>▼ＴＷさん：
>
>回答ではない連投で失礼します。
>
>>会社でマクロ無効が標準設定なので
>>マクロ無効でも、マクロが動くようにしたつもりです。
>
>私がどうこう申し上げる立場ではないのですが、具体的にどのような設定なのかは別にして
>会社のセキュリティポリシーとしてエクセルマクロを禁止しているとすれば、
>テクニックとして、それをかいくぐって、マクロブックのマクロを実行するということが
>どうなのかなぁ？　と思ったりします。

・ツリー全体表示


	【79001】Re:最前面

ＴＷ - 17/4/5(水) 7:43 -


	引用なし

	パスワード

γ さん

　　大変に失礼いたしました。おっしゃるとおりです
　　また。参考コード大変ありがとうございました。
　　思うとおりの動作ができました。
　　お忙しいところお手数かけますが、よろしくお願いいたします。

▼γ さん：
>時間がとれずやっつけですが、こんなふうなことですか？
>テスト検証を十分していません。そちらでよろしく願いたい。
>
>なお、Wscript.Shell の Runメソッドで Excelを起動するなんていうのもありかも。
>
>========== 以下参考コード ====================

・ツリー全体表示


	【79000】Re:最前面

γ - 17/4/4(火) 21:26 -


	引用なし

	パスワード

時間がとれずやっつけですが、こんなふうなことですか？
テスト検証を十分していません。そちらでよろしく願いたい。

なお、Wscript.Shell の Runメソッドで Excelを起動するなんていうのもありかも。

========== 以下参考コード ====================

fname = "test.xlsm"

Spa = WScript.ScriptFullName
Fpath = Left(Spa, InStrRev(Spa, "\") - 1)
OPFL = Fpath & "\" & fname

On Error Resume Next
Set ExlApp = GetObject(, "Excel.Application")
If ExlApp Is Nothing Then
　　Set ExlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0

ExlApp.Visible = True
ExlApp.DisplayAlerts = False
ExlApp.EnableEvents = False
ExlApp.Workbooks.Open OPFL
'　　ExlApp.Run ("'" & OPFL & "'!Auto_Open")
ExlApp.EnableEvents = True
ExlApp.Windows(fname).Visible = True

CreateObject("WScript.Shell").AppActivate ExlApp.Caption

========== コード終わり =========

なお、コメントをいただいておきながら放置は頂けない。
社会人としていかがなものか。
今からでもきちんと対応しておくべきだ。

・ツリー全体表示


	【78999】Re:最前面

ＴＷ - 17/4/4(火) 8:43 -


	引用なし

	パスワード

β さん
御忠告ありがとうございます

マクロは会社から許可を取って、信頼される・・と言う形です
マクロを有効にすることができなかったり
間違えたり、無効にするのを忘れる社員がいるので、
仕方なくの対応です。

説明不足で申し訳ありませんでした。

▼β さん：
>▼ＴＷさん：
>
>回答ではない連投で失礼します。
>
>>会社でマクロ無効が標準設定なので
>>マクロ無効でも、マクロが動くようにしたつもりです。
>
>私がどうこう申し上げる立場ではないのですが、具体的にどのような設定なのかは別にして
>会社のセキュリティポリシーとしてエクセルマクロを禁止しているとすれば、
>テクニックとして、それをかいくぐって、マクロブックのマクロを実行するということが
>どうなのかなぁ？　と思ったりします。

・ツリー全体表示


	【78998】Re:最前面

β - 17/4/4(火) 8:33 -


	引用なし

	パスワード

▼ＴＷさん：

回答ではない連投で失礼します。

>会社でマクロ無効が標準設定なので
>マクロ無効でも、マクロが動くようにしたつもりです。

私がどうこう申し上げる立場ではないのですが、具体的にどのような設定なのかは別にして
会社のセキュリティポリシーとしてエクセルマクロを禁止しているとすれば、
テクニックとして、それをかいくぐって、マクロブックのマクロを実行するということが
どうなのかなぁ？　と思ったりします。

・ツリー全体表示


	【78997】Re:最前面

β - 17/4/4(火) 8:25 -


	引用なし

	パスワード

▼ＴＷさん：

回答ではありません。

h tp://www.excel.studio-kazu.jp/kw/20170329095243.html

ここでは具体的に役に立つ回答をすることができていない状況ですけど
何らかのレスを返していただくなり、継続してＱ／Ａを続けられても
よかったのではと、ちょっと残念です。

・ツリー全体表示


	【78996】Re:別ウィンドウのワークシート間コピー

エリエール - 17/4/4(火) 8:04 -


	引用なし

	パスワード

γさんへ

■私が提示したコードをそのまま使わなかった理由は？

　正直申しますと疲れによる私の完全なミスです。
申し訳なかったです。おっしゃっていたご指摘は理解して
訂正したつもりでしたが、間違っていました。

■GetObjectを使う理由がいまいち理解できておらず、

　別ウィンドウのワークシート間コピーの方法を探していたら
GetObjectが良いと考えたからです。他に最適な方法が有るとしても
現在の私の力量では思いつくことは無理です。

以上です。

>βさん　いつもながら適切な解説ありがとうございました。
>
>質問者さんへ
>私が提示したコードをそのまま使わなかった理由は？
>（理解せずに Withステートメントとその対である .ドットを
>　使うよりも、間違い無いだろうと思ったのですが。）
>
>GetObjectを使う理由がいまいち理解できておらず、
>当初の動作不良となる原因が別にあるのかもしれないなあと
>思ってもいます。

・ツリー全体表示


	【78995】Re:最前面

ＴＷ - 17/4/4(火) 7:44 -


	引用なし

	パスワード

γ さん、説明不足で申し訳ありません

batでエクセルを起動してます、会社でマクロ無効が標準設定なので
マクロ無効でも、マクロが動くようにしたつもりです。

BAT等作業用のファイルがフォルダに入れてあり、
フォルダを開いて、BATをクリックすると
フォルダの後ろになってしまいます。

他のアプリは開いていても、フォルダを開くので
その時フォルダが最前面なので、フォルダの後ろ
その他のアプリの前に開きます。

BATは

Spa = WScript.ScriptFullName
　Fpath = Left(Spa, InStrRev(Spa, "\") - 1)
　 OPFL = Fpath & "\sagyou.xlsm"
　 On Error Resume Next
　　Set ExlApp = GetObject(, "Excel.Application")
　　 If ExlApp Is Nothing Then
　　　Set ExlApp = CreateObject("Excel.Application")
　　 Else
　　End If
　ExlApp.Visible = True
　AppActivate ExlApp.Caption
　　ExlApp.DisplayAlerts = False
　　ExlApp.EnableEvents = False
　　ExlApp.Workbooks.Open OPFL
　　ExlApp.Run ("'" & OPFL & "'!Auto_Open")
　　ExlApp.EnableEvents = True

sagyouと言うエクセルを開きます。
このsagyouにマクロが複数有り仕事しますが
どうしても、最前面になりません。
アドバイスをよろしくお願いします

▼γ さん：
>>batでエクセルを起動してますが、色々調べても、
>>どうしても最前面に表示されません
>
>・どのようなbatなのか、
>・Excelよりも前面に出るアプリケーションは何か、
>などを説明されたらいかがですか？
>今のままだと説明不足で、回答のしようがないように思います。

・ツリー全体表示


	【78994】Re:別ウィンドウのワークシート間コピー

エリエール - 17/4/4(火) 7:40 -


	引用なし

	パスワード

　γさん、βさんありがとうございます。

　コードをγさんの当初ご指摘とおり訂正したらうまくいきました。
βさん、見るに見かねての助け舟ありがとうございます。

　本当にありがとうございました。

　
■該当箇所の訂正後

　With SheetB

.Activate

.Range(.Cells(1, 1), .Cells(4, 4)) = OutData

End With

以上です。

・ツリー全体表示


	【78993】Re:最前面

γ - 17/4/4(火) 7:33 -


	引用なし

	パスワード

>batでエクセルを起動してますが、色々調べても、
>どうしても最前面に表示されません

・どのようなbatなのか、
・Excelよりも前面に出るアプリケーションは何か、
などを説明されたらいかがですか？
今のままだと説明不足で、回答のしようがないように思います。

・ツリー全体表示


	【78992】Re:別ウィンドウのワークシート間コピー

γ - 17/4/4(火) 7:31 -


	引用なし

	パスワード

βさん　いつもながら適切な解説ありがとうございました。

質問者さんへ
私が提示したコードをそのまま使わなかった理由は？
（理解せずに Withステートメントとその対である .ドットを
　使うよりも、間違い無いだろうと思ったのですが。）

GetObjectを使う理由がいまいち理解できておらず、
当初の動作不良となる原因が別にあるのかもしれないなあと
思ってもいます。

・ツリー全体表示


	【78991】Re:別ウィンドウのワークシート間コピー

β - 17/4/4(火) 0:33 -


	引用なし

	パスワード

▼エリエールさん：

横から失礼します。
γさんのしてきは　SheetB.Range(セル1,セル2) の　かっこの中のセルが SheetBのセルだと認識されないということでしたね。

それを　SheetB.Range(.セル1,.セル2) とピリオドをつけられたわけですが
この　ピリオドは、このコードに先行して With なんたら　というものがあって初めて

『その　セル1』といった意味になります。つまり　ピリオドは　『その』という意味です。

さて、この場合、『その』は、何なのか、どこかに宣言がありますか？

記述するなら

With SheetB
　.Range(.セル1,.セル2)
End With

といった記述になるでしょうね。

あるいは

SheetB.Range(SheetB.Cells(1, 1), SheetB.Cells(4, 4))

でもいいですし、

Range(SheetB.Cells(1, 1), SheetB.Cells(4, 4))

でもいいです。

・ツリー全体表示


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

173 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free