[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロ実行中のメッセージボックスが表示されないようにしたい』(ゆうこ)
現在使用しているマクロで、マクロ実行させると
メッセージボックスで処理を選択するようになっているのですが
それを表示させないようにするには、どうしたらいいでしょうか?
画像を指定の結合セルにぴったりサイズが合うように挿入したいのですが
メッセージボックスで表示される選択肢は、すべて「はい」を選択するものとして
メッセージボックスを表示させずにすべての処理を完了させたいです。
初心者のため、うまく説明できずすみません。
現在利用しているマクロは下記の通りです。
Dim n, fi, cc As Range, ya, ca, g, ok, fl, l
Sub 複数画像の挿入()
Dim a, c, sr, sc, s, rr, pkfile, ar, ac, z, rc, ccc, ca0 On Error GoTo err Set a = Application.InputBox("画像を挿入するセルを選択してください" _ & Chr(13) & Chr(10) & "複数選択可 (ShiftキーまたはCtrlキーで選択)" _ , "複数画像の一括挿入(セル選択)", Selection.Address, , , , , 8) Application.ScreenUpdating = False a.Select sr = Selection.Row sc = Selection.Column rr = sr pkfile = Application.GetOpenFilename _ ("すべての図(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.gif), *.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.gif", 2, "挿入する図の選択(複数選択可)", , True) If Not IsArray(pkfile) Then MsgBox "ファイルが指定されていません", , "複数画像の一括挿入": End For fi = 1 To UBound(pkfile) If pkfile(fi) = False Then MsgBox "ファイルが指定されていません", , "複数画像の一括挿入": End 'キャンセルの場合終わる Next fi n = ActiveSheet.Pictures.Count Application.DisplayAlerts = False z = MsgBox("画像のサイズをセルに合わせますか", vbYesNo, "複数画像の挿入") ok = 0 If Application.Version < 12 Then If MsgBox("縦横比を保持しますか", 4, "複数画像の一括挿入") = 6 Then ok = 0 Else ok = 1 End If If z = 6 Then ya = MsgBox("画像圧縮しますか", vbYesNo, "複数画像の挿入") l = MsgBox("元の画像へのリンクを作成しますか", 4 + 256)
ar = a.Address ac = Range(ar).Count fi = 1 If ac > 1 Then GoTo ech Else GoTo pc ech: ca0 = "" For Each cc In ActiveSheet.Range(ar) ca = Range(cc.Address).MergeArea.Address rc = Range(ca).Rows.Count ccc = Range(ca).Columns.Count If rc > 1 Or cc > 1 Then ca = Cells(Range(ca).Row + rc - 1, Range(ca).Column + ccc - 1).Address End If If ca0 = ca Then GoTo mne ca0 = ca ca = Range(cc.Address).MergeArea.Address Range(ca).Select
' cc.Select
g = ActiveSheet.Shapes.AddPicture( _ Filename:=pkfile(fi), _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=400#, _ Height:=300#).Name '図のサイズを元のサイズに戻します
With ActiveSheet.Shapes(g) .ScaleHeight 1!, msoTrue .ScaleWidth 1!, msoTrue End With
fl = pkfile(fi) '右のセルにファイル名を表示 Cells(Range(ca).Row, Range(ca).Column + 1) = fl
If z = 6 Then セルにサイズを合わせる fi = fi + 1 If fi = UBound(pkfile) + 1 Then GoTo en mne: Next Application.DisplayAlerts = True a.Select Exit Sub
pc:
For fi = 1 To UBound(pkfile) ca = Cells(rr, sc).Address Range(ca).Select g = ActiveSheet.Shapes.AddPicture( _ Filename:=pkfile(fi), _ LinkToFile:=False, _ SaveWithDocument:=True, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=400#, _ Height:=300#).Name '図のサイズを元のサイズに戻します
With ActiveSheet.Shapes(g) .ScaleHeight 1!, msoTrue .ScaleWidth 1!, msoTrue End With
fl = pkfile(fi) '右のセルにファイル名を表示 Cells(Range(ca).Row, Range(ca).Column + 1) = fl
If z = 6 Then セルにサイズを合わせる rr = rr + 1 Next fi Exit Sub en: Application.DisplayAlerts = True Application.ScreenUpdating = False
a.Select Exit Sub err: MsgBox "選択が正しくありません", , "複数画像の一括挿入" End Sub
Sub セルにサイズを合わせる()
Dim c As Range, cm As Range Dim rX As Single, rY As Single, r As Single
Application.ScreenUpdating = False ' For Each c In Selection
' Set cm = c.MergeArea
Set cm = Range(ca) ' If c.Address = cm.Item(1).Address Then ' If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub ActiveSheet.Shapes(g).Select With Selection rX = cm.Width / .Width rY = cm.Height / .Height If ok = 0 Then If rX < rY Then cx = .Width * rX cy = .Height * rX Else cx = .Width * rY cy = .Height * rY End If Else cx = cm.Width cy = cm.Height End If .Width = cx .Height = cy .Left = cm.Left .Top = cm.Top + cm.Height - .Height If ya = 6 Then 図の圧縮 End With ' End If ' Next Set cm = Nothing Application.ScreenUpdating = True End Sub Sub 図の圧縮() Selection.Cut Range(ca).Select ActiveSheet.PasteSpecial Format:="図 (JPEG)" If l = 6 Then ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=fl Else Cells(Range(ca).Row, Range(ca).Column + 1) = "" End If g = Selection.ShapeRange.Name
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows8 >
どこから参照したかはわかりませんが、ずいぶんとごちゃごちゃとしたコードですね。
こういっては失礼ですけれど、プログラミングの悪い書き方を集めたようなコードで 初心者でなくとも、処理を追いかけるのは大変そうです。
無責任な回答になりますが、とりあえず所望のことを実現するには、 z = MsgBox("画像のサイズをセルに合わせますか", vbYesNo, "複数画像の挿入") のような箇所を z = vbYes のように置き換えることで、メッセージボックスで YESを選択したのと同等になります。
ですが、このような変更を積み重ねると、さらに可読性や保守性が低下するので、 できれば一度目的に合わせて整理した方が、今後のためのような気はします。
特にあちこちに散見するマジックナンバー(意味の分からない定数)はきちんと 定義名を使用した方が良いと思います。
http://www.geocities.jp/cbc_vbnet/function/mseegefunction.html
If z = 6 Then なんてコードを見て、これが YES を選択したときの処理だなんて、特に初心者には 想像もつかないのではないでしょうか。
(Mook) 2014/07/21(月) 22:08
さっそくのご回答、ありがとうございます。
教えていただいた通りに置き換えて、メッセージボックスを表示させずに処理することができました。
ありがとうございました。
今後いろいろと勉強していきたいと思います。
本当にありがとうございました。
(ゆうこ) 2014/07/21(月) 22:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.