Excel VBA質問箱 IV

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

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


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

172 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79015】Re:チェックボックスがONの場合に選択し...

β - 17/4/14(金) 15:37 -


	引用なし

	パスワード

▼ペーターパンさん：

一例です。
以下のマクロを　標準モジュールに記載して、該当のチェックボックスをすべて選んで
この同じマクロを登録してください。

なお、現行のコード、いったんシート状のすべてのセルの文字の太さを通常にし
そのあと、該当の行の文字の太さのみを太字にしていますが、太字にするのは
チェックボックスが選ばれたときのみと考えれば、その行についてのみ
選ばれれば太字、選択が外れれば通常という制御にしました。

Sub フォント切り替え()
　　Dim flg As Boolean
　　
　　With ActiveSheet.CheckBoxes(Application.Caller)
　　　　If .Value = xlOn Then flg = True
　　　　.TopLeftCell.EntireRow.Font.Bold = flg
　　End With
　　
End Sub

・ツリー全体表示


	【79014】Re:チェックボックスがONの場合に選択し...

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


	引用なし

	パスワード

▼β さん：

私感ではありますが、トラブル等が起きにくいフォームツールを使いたいです。
ある特定のワークシート場でのみ機能させたいと思っております。

下記、丁寧な説明ありがとうございます。
動かない理由についてはよく分かりました。
勉強になります。

▼β さん：
>▼ペーターパンさん：
>
>よく読むと Application.Caller を使っておられるので
>フォームツールのチェックボックスなんですね。
>
>であれば　値そのものは xlOn や xlOff でいいのですが
>この場合は、自分でマクロを最初から最後まで書いて
>それを　チェックボックスにマクロ登録するわけですね。
>
>名前を　checkbox1_click　とされるのは、勝手というか、すきにしたらいいのですが
>　
>Private Sub checkbox1_click(ByVal Target As Range)
>
>この　( ) 内の引数、これは誰もセットしてくれません。
>
>しかも、この形だと、マクロ登録しようにも、登録できません。
>
>かつ、ActiveXであっても、フォームツールであっても、チェックボックスがクリックされたときに
>そのチェックボックスが配置されているセルを Target といったセルオブジェクトで
>返してくれるなんて親切な構造にはなっていません。
>
>あくまで、クリックされたオブジェクトが何であるかがわかるだけで
>そのオブジェクト.TopLeftCell といったもので、その場所を把握する必要があります。
>
>配置しようとしているのは ActiveX ですか？　フォームツールですか？
>いずれであってもアップされたコードでは動きませんが、いずれかによって
>正しいコードが異なってきますので。

・ツリー全体表示


	【79013】Re:チェックボックスがONの場合に選択し...

β - 17/4/14(金) 14:19 -


	引用なし

	パスワード

▼ペーターパンさん：

よく読むと Application.Caller を使っておられるので
フォームツールのチェックボックスなんですね。

であれば　値そのものは xlOn や xlOff でいいのですが
この場合は、自分でマクロを最初から最後まで書いて
それを　チェックボックスにマクロ登録するわけですね。

名前を　checkbox1_click　とされるのは、勝手というか、すきにしたらいいのですが
　
Private Sub checkbox1_click(ByVal Target As Range)

この　( ) 内の引数、これは誰もセットしてくれません。

しかも、この形だと、マクロ登録しようにも、登録できません。

かつ、ActiveXであっても、フォームツールであっても、チェックボックスがクリックされたときに
そのチェックボックスが配置されているセルを Target といったセルオブジェクトで
返してくれるなんて親切な構造にはなっていません。

あくまで、クリックされたオブジェクトが何であるかがわかるだけで
そのオブジェクト.TopLeftCell といったもので、その場所を把握する必要があります。

配置しようとしているのは ActiveX ですか？　フォームツールですか？
いずれであってもアップされたコードでは動きませんが、いずれかによって
正しいコードが異なってきますので。

・ツリー全体表示


	【79012】Re:チェックボックスがONの場合に選択し...

β - 17/4/14(金) 13:12 -


	引用なし

	パスワード

▼ペーターパンさん：

ActiveX のチェックボックスの値は xlOn や xlOff ではなく　True や Fales です。

・ツリー全体表示


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

boss - 17/4/14(金) 12:42 -


	引用なし

	パスワード

▼γ さん：
早速のご回答ありがとうございます。
説明不足、vba素人につきお手数をお掛けしております。
いただいた質問への回答と「Exit Forでループを脱出しています」を
検証しておりますので結果についは後報いたします。
先ずは御礼です。

・ツリー全体表示


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

・ツリー全体表示


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

172 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free