今だけ人気マンガ100円レンタル特集♪

お世話になります。

Excelで関数等多様しているファイルを印刷プレビューすると、
以上に遅くなります。
当たり前なのかも知れませんが、遅いのを解消する方法って
ありますか。
関数部分をExcel開いたときにVBAで処理する様にしたら
印刷プレビューは早くなりますかね。
他に単純簡単に早くする方法等あれば、ご教示頂きたく
宜しくお願い致します。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

一つの可能性として、ウィンドウズ画面でマイコンピュータを右クリックして「ネットワークドライブの切断」を行い、切断できるモノはありませんになるまで全部切断してからパソコンを再起動、そして状況を確認してみます。



またそもそも単純な方法としては、可能ならウィンドウズの標準のプリンタを別のプリンタに変えてからエクセルを起動し、状況を確認します。


>関数

通常、関数が理由でご相談の状況が発生する事はありません。
でも気になるなら、エクセルのオプションで再計算を手動にしておいて、印刷プレビューをしてみます。



あとはご利用のウィンドウズの種類も不明、ご利用のエクセルのバージョンも不明のご相談ですが、エクセル2007をご利用の場合、いろいろと遅い可能性があります。
ウィンドウズアップデートからオフィス2007のアップデートを行う事で、若干改善する可能性はあります。が、あまり劇的には高速化しないので、可能な状況で2010にアップグレードする事をお勧めします。
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL 印刷プレビューの後画面が重くなる

EXCEL2003を使用しておりますが、

印刷プレビューの後画面スクロールなどの処理が重くなります。

PCのスペックは、CPU 1GB メモリ1GBです。

EXCELのファイルサイズは400kでシート数は15です。

原因など心当たりのある方はアドバイスいただけると助かります。

Aベストアンサー

回答No.1です。

ローカルのプリンタがない場合、「Microsft Office Document Image Writer」を通常使うプリンタに設定すればいいと思います。あるいは、プリンタドライバを削除するか、一時的にネットワークケーブルを外してみるか。もしこれで軽くなるようなら、ネットワークプリンタが原因です。

解決策ですが、私の場合はもう1台のPCをプリントサーバとして使っていたのを、プリンタ切り替え機での接続に変えました。その後、ネットワークボードを買って、プリンタ単独でLANにつないでいますが、遅くなることはありません。

MSのサイトにはプリントサーバのOSがWin95/98/Meなどだと起こると書いてありましたが、私の場合はXpでした。

Q印刷作業が重い

Wordで印刷をする際、ファイル→印刷とクリックするとまず応答なしになります。それを5分ほど放っておくと、印刷の画面が出ます。設定をして印刷をクリックするとまた応答なしになります。そしてまた5分くらいたつと印刷プレビューが出ます。

この症状は他のソフトでも出ます。今のところ一太郎とPhotoshopで出ています。

それ以外の動作は、全くもってストレス無く軽快に動いています。印刷に関わることだけ異様に遅いです。

解決策を教えて下さい。


Operating System: Windows 7 Home Premium 64-bit (6.1, Build 7601)
BIOS: BIOS Date: 04/12/11 19:44:42 Ver: 04.06.04
Processor: Intel(R) Core(TM) i7-2600 CPU @ 3.40GHz (8 CPUs), ~3.4GHz
Memory: 4096MB RAM
Available OS Memory: 4074MB RAM
Page File: 2620MB used, 5526MB available

Wordで印刷をする際、ファイル→印刷とクリックするとまず応答なしになります。それを5分ほど放っておくと、印刷の画面が出ます。設定をして印刷をクリックするとまた応答なしになります。そしてまた5分くらいたつと印刷プレビューが出ます。

この症状は他のソフトでも出ます。今のところ一太郎とPhotoshopで出ています。

それ以外の動作は、全くもってストレス無く軽快に動いています。印刷に関わることだけ異様に遅いです。

解決策を教えて下さい。


Operating System: Windows 7 Home Premium 64-bit (6.1...続きを読む

Aベストアンサー

OSも重要ですけど、重要なプリンタ環境(プリンタ、プリンタの接続方法<USB、LAN、プリンタポート、ローカルポート、その他専用印刷サービスなど>)が、書かれていないので、ほぼすべてのケースを網羅して書きます。

アプリケーションが原因なのかどうかも・・・。原因調査の基本で、行き詰ったらもっと広い視野で考え直すのが大事です。この手の解決は、メーカーサポートを使う以外には、自分で探してやることになりますが・・・。あくまで、可能性のあることを網羅することと、原因を探す方法を記載することしかできません。そのため、参考程度に考えてください。

まず調べることは、タスクマネージャーを起動した状態で、印刷を掛けること。
プロセスタブでCPUの昇順ソート(使用率の高い順)を行い。イメージ名のどれが、CPUリソースを多く消費しているかを確認することです。ソフトが原因だと思うなら、リソースを多く消費しているプロセス順に当たりを付けて、問題を探ります。(ちなみに、最も消費しているから、それが原因であるわけではありません。WINWORD.exeが90%消費でも、実はその先のキューが止まっており、2番目、3番目の方が原因ということもある)

また、その確認が完了したら、パフォーマンスタブからリソースモニターを起動し、該当のプロセスメモリ利用率やCPUの利用率をマーク(監視)します。

それが原因の可能性が高いと思ったら、そのプロセスがどんな役割を持つかを確認します。
まあ、たぶんソフト要因なら、PrintSpoolerサービスか、印刷キュー(デバイスとプリンタの該当プリンタ→プリンタのプロパティ→ポート→双方向サポートおよびプリンタプールを有効にするのどちらが誤って設定されている。プリンタによって設定は違うので、デフォルトがどちらが良いかは分かりませんが・・・)の管理に問題があるか、もしくは、プリンタケーブルの破損、ネットワークプリンタの場合は通信エラーによるリトライが繰り返されているなどもあります。(USBホストコントローラなどPCのマザーボード不良などが原因の場合もあります。この場合は、プリンタがUSB接続ならUSBポートを変更すると改善するかも・・・)

もし、最近msconfig(システム構成ユーティリティ/一般にデバッグ用の構成設定を行うWindowsツール)などを弄った記憶があるなら、それが原因かもしれません。これは、基本的には使わないようにしてください。(一般に、サービスの大半は所定の手段を使えば、コントロールパネルやコマンドからこれを使わなくとも停止できます。)

後は、ドライバに問題がある→最新のドライバを適用するか、過去のバージョンにロールバックする。

プリンタドライバの印刷設定が、処理に時間がかかる高画質、高精細な処理設定になっている→一部プリンタでは、印刷開始までに大量のメモリを消費し、ウォームアップまでの動作が遅くなることがあります。

ぐらいかな?
これで、解決できるかどうかは分かりませんが、とにかくまずケーブルなども含めたハードも疑うことです。(そちらが原因の方が解決は早いですから)
そのうえで、ソフトに移行する。ソフトの場合は、印刷が出来ないことを考えて、プリンタに関わる部分を重点的に疑うことになります。まあ、ドライバをアンインストールして入れなおすと案外治ることもあります。尚、共有プリンタ(ほかのPCのプリンタドライバを共有して印刷している。そのPCの電源が入っていないと印刷できない)を使っている場合は、ホストPC(プリンタサーバとなるPC)に問題がある場合や、LAN経由(特に無線)の印刷だとネットワーク関連の問題も考えられます。

OSも重要ですけど、重要なプリンタ環境(プリンタ、プリンタの接続方法<USB、LAN、プリンタポート、ローカルポート、その他専用印刷サービスなど>)が、書かれていないので、ほぼすべてのケースを網羅して書きます。

アプリケーションが原因なのかどうかも・・・。原因調査の基本で、行き詰ったらもっと広い視野で考え直すのが大事です。この手の解決は、メーカーサポートを使う以外には、自分で探してやることになりますが・・・。あくまで、可能性のあることを網羅することと、原因を探す方法を記載することし...続きを読む

QExcelのマクロで印刷設定をすると遅くなる

Excelのマクロについて
久しぶりに質問させていただきます。
マクロで印刷の設定をすると
遅くなるのでしょうか?

Range("A1:Z10").Select
With ActiveSheet.PageSetup
 .Orientation = xlLandscape
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = 1
 .TopMargin = Application.CentimetersToPoints(1)
 .BottomMargin = Application.CentimetersToPoints(1)
 .LeftMargin = Application.CentimetersToPoints(1)
 .RightMargin = Application.CentimetersToPoints(1)
End With
Selection.PrintPreview

というようなマクロを作って実行すると
プレビュー画面が出るまでに
かなり時間がかかるのです。
職場のパソコンであるため
パソコンそのものがかなり古いのですが
マクロを使わずに直接、印刷の設定をすれば
すぐにプレビューが表示されます。
ただ、同じシートをいろいろな方法で印刷する必要があるため
マクロを組んでみたわけです。

ちょっと我慢すればいいだけで
仕事そのものに大きく影響するわけではありませんが
皆様のご助言をよろしくお願いいたします。

Excelのマクロについて
久しぶりに質問させていただきます。
マクロで印刷の設定をすると
遅くなるのでしょうか?

Range("A1:Z10").Select
With ActiveSheet.PageSetup
 .Orientation = xlLandscape
 .Zoom = False
 .FitToPagesWide = 1
 .FitToPagesTall = 1
 .TopMargin = Application.CentimetersToPoints(1)
 .BottomMargin = Application.CentimetersToPoints(1)
 .LeftMargin = Application.CentimetersToPoints(1)
 .RightMargin = Application.CentimetersToPoints(1)
End With
...続きを読む

Aベストアンサー

> マクロで印刷の設定をすると
> 遅くなるのでしょうか?

わたしのエクセル2000でも同様に、VBAで印刷のページ設定を行うと非常に遅いです。
ページ設定のコードの前後を、

Application.ScreenUpdating = False と、

Application.ScreenUpdating = True ではさんで画面更新を止めても多少かわる程度かな。

何パターンかページ設定した複数の「雛形」シートを用意しておいて、印刷したいデータだけ、「雛型」に貼り付けするって方法はどうでしょうか?

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QエクセルVBAでクリップボード内容をクリア

こんにちは。
エクセルのVBAの処理の中で、ある部分をコピーしてそれを、
貼り付けする処理をしています。
処理終了後、ファイルを閉じるときに、クリップボードに
コピーの内容が残っている旨のメッセージがでてきます。
このメッセージを出さない様に、クリップボードの内容を
クリアするにはどのようにすればよろしいでしょうか?
申し訳ありませんが、お教え頂きますようお願いいたします。

Aベストアンサー

Excel.Application.CutCopyMode = False
Workbooks(fName).Close savechanges:=False

かな。1行目だけでいいかも。

QエクセルでPCが変わると印刷範囲が変わる

新しくPCを購入しました。
Windows8、office2013です。
今まではWindowsXP(office2003)、WindowsVista(office2007)、Windows7(office2010)と様々なPCで共有していたエクセルファイルですが、Windows8(office2013)で印刷しようとしたところ、印刷範囲がずれてしまい、困っています。
プリンターが変わると範囲がずれるのは知っていたのですが、今回はプリンターは同じです。
今まで問題なくできていたのになぜ?って感じです。
新しいPCの印刷範囲に合わせてファイルを作り直すと、他のPCでは印刷がずれてしまうので、どうしたものかと悩んでいます。
よい方法はありませんか?

Aベストアンサー

OSが変わると同じドライバでも印刷範囲は変わるかもですね。

OSがデータをプリンタドライバに投げる・・・このインターフェイス
は規定されているんですが、投げた結果を受けてWindows上で
表示する処理と、結果を受けて再度プリンタに投げるデータの
詳細は「インターフェイス」以外決まってない・・・というかMicrosoft
の外部からはわからないんです。

OSが変わると、戻ってくるデータも変わってきますから、ドライバを
作るメーカーも、実際作ってみて「あ、違った」ってことがあります。
特に新しいWindowsではそういうことがあるんです。

同じドライバでずれるなら、メーカーに新しいドライバが上がって
ないか確認した方がいいですが、差し替えたらもっとずれちゃった
ってこともあるんでねえ・・・。頑張って直してください、としか言い
ようがありません。

QEXCELにて変更していないのに毎回保存するかを聞かれます。

EXCELにて何も変更した箇所が無いのにも関わらず、毎回変更を保存しますかと、ポップアップが出ます。

今までは何の問題も無く使っていたファイルです。
特に思い当たる節もなく、気になっております。

誰か分かる方はおりますでしょうか?
お願いいたします。

また、簡単な関数しか使っておりません。
マクロも使っておりません。

Aベストアンサー

=NOW()
=TODAY()
のような関数は前回の状態と今回開いた状態とで値が異なりますので
自分が変更していなくても画面的には変更されています

また外部参照(リンク)がある場合も
自分のファイルが変わっていなくてもリンク先が変わっていれば変更ありとなります

このような場合は開いてすぐ閉じても保存しますかメッセージが出ます

余談ですが「ツール」→「アドイン」で自動保存にチェックを入れると
一定間隔ごとにメッセージが出ます

QExcel)軽いデーターのはずなのに、メチャメチャ重い!

こんにちは。
会社の共有フォルダーに「見積り書」というエクセルファイルがあります。
従業員はそれを各PCにダウンロードして、それぞれが見積りを作ります。
ある日をきっかけにめちゃめちゃこの見積りが重くなりました。
このたった1枚の見積りなのにサイズは4MB。写真、画像、マクロ、一切ありません。
それならまだ許せるのですが、、開くのにかーーーーなり時間かかります。5分以上はかかります。

「誰が触った!」「どう触った!」など調べるより新しく作り直そうと試みました。

なんとか10分ほど待って開きました。
そして7列x20行ほどのセルを囲んで「Ctrl」+「C」を押してコピーして、その新しいエクセルに貼付けようと試みました。
ところがコピーした段階でまた「応答無し」なります。
この症状は1人を除く従業員全員、しかもこの見積りだけです。あとはスイスイ開きます。
どれかのセルにゴミのようなデーターが入ってしまってるのでしょうか。
何が原因でしょうか?考えられるものを挙げていただけましたら幸甚です。

Aベストアンサー

コメントでも大量に入力されたのでしょうか。コメントの付いたセルはセルの右上に赤い三角マークが付くので見た目で分かります。コメントってテキストだから容量は大きくならないと思っていたんですけど、入れると凄く大きくなるんです。びっくりしました。

入力されている数式や書式を諦められるなら、他のbookからその問題のbookを参照してはいかがでしょう。値だけを参照するだけですので不要なものは一切付いてきません。
問題のファイル(Book)をBook1とした場合、Book2のA1セルに
=[Book1]Seet1!A1
と入力して必要な範囲までコピーします。
そののちに、Book2のseet全体をコピーして、「形式を選択して貼り付け」から「値」を選んで同じ範囲に上書き貼り付けすると良いです。
あとは正常に開ける人のパソコンの画面を見ながら数式や書式を設定してみてください。

QVMWare仮想ソケット数とソケットあたりのコア数

VMWareバージョン5.0から仮想OSに割り当てるCPUの設定で仮想ソケット数とソケットあたりのコア数というのがあり、それぞれを掛けた値が仮想OS毎のコア合計数となる様です。
以下の内容について教えていただけませんでしょうか。

(1)ソケット数とコア数がどのようなものなのかというのが解っていません。
どのように算出された計算値からこれを設定すればいいのか教えていただけますでしょうか。

(2)コア合計数を2としたい場合仮想ソケット数を2にし、ソケットあたりのコア数を1にする
 のでしょうか?それとも逆に仮想ソケット数を1にし、ソケットあたりのコア数を2にすれば
 良いでしょうか?

宜しくお願い致します。

Aベストアンサー

ちょっとかじった程度の技術者です。
専門家ではないので参考程度に。

(1)コアはCPUの中にあり、実際に計算をする部分になります。
複数のコアを持っているCPUは同時に複数の処理をする事ができます。

コア数はCPUによって決まっていて、1つのCPUに2つとか4つとか複数のコアが
搭載されている場合があります。(例:デュアルコア=2個、クアッドコア=4個)

ソケットとはCPUを搭載する部分の事で、1つのソケットに1つのCPUが載ります。

という事で、例えば「クアッドコアのCPUを2個搭載」した場合、
・コア数=4
・ソケット数=2
となり、仮想OSに割り当てられる仮想CPUは「4×2=8個」となります。

(2)仮想ソケット数については「どの様な挙動をさせたいか」「OSの制限」
などによって異なると思います。

デュアルコアCPUが1個搭載されているような挙動を期待しているなら
仮想ソケット数を1に、コア数を2に。
シングルコアのCPUが2個搭載されている様な挙動を期待しているなら
仮想ソケット数を2に、コア数を1に。

OSの制限についてですが、OSによってはソケット数が決まっているケースがあります。
WindowsXPの場合はCPUが2個までしか載せられなかったと思います。
その時は仮想ソケット数は「2」までしか設定できない事になり、仮想CPUを4つに
設定したい時は仮想ソケット数を2に、コア数を2に設定する事になります。

という事でこの場合は「環境と希望による」という回答になると思います。

ちょっとかじった程度の技術者です。
専門家ではないので参考程度に。

(1)コアはCPUの中にあり、実際に計算をする部分になります。
複数のコアを持っているCPUは同時に複数の処理をする事ができます。

コア数はCPUによって決まっていて、1つのCPUに2つとか4つとか複数のコアが
搭載されている場合があります。(例:デュアルコア=2個、クアッドコア=4個)

ソケットとはCPUを搭載する部分の事で、1つのソケットに1つのCPUが載ります。

という事で、例えば「クアッドコアのCPUを2個搭載」した場合、
・コア数...続きを読む

Qフォントの大きさ

Msg_box 関数 でメッセージを出力しているのですが
マーク(注意、警告 etc)を用いての表現の方法しかないのでしょうか?
 例えば メッセージのフォントのサイズを各々メッセージによって
     変えれないのでしょうか?
初歩的なご質問で申し訳御座いません
宜しくお願いします

Aベストアンサー

一応サンプルを作りました。
やってみて面白かったけど、やはりオリジナルを作ったほうがかなり楽だということを実感しました。

注意:
ここの掲示板は文字がずれるので、図形が壊れます。以下の文章をメモ帳などのテキストエディタにコピって読んでください。

・・・さて本題・・・


※メッセージボックスの構造
┏━━━━━━━━━━━━━━━━┓
┣━━━━━━━━━━━━━━━━┫
┃                ┃
┃ ┏━┓ ┏━━━━━━━━┓ ┃
┃ ┃I┃ ┃MSG_AREA┃ ┃
┃ ┗━┛ ┗━━━━━━━━┛ ┃
┃                ┃
┃   ┏━━┓  ┏━━┓   ┃
┃   ┃B1┃  ┃B2┃   ┃
┃   ┗━━┛  ┗━━┛   ┃
┗━━━━━━━━━━━━━━━━┛
[I]・・・アイコン(クラス名:Static)
[MSG_AREA]・・・メッセージ表示領域(クラス名:Static)
[B1/B2]・・・ボタン(クラス名:Button)
という構造になっています

メッセージボックスは指定のスタイルによりアイコンの有無・ボタンの数が変化します。
また、メッセージ文字数により、メッセージの表示領域が変更され、ダイアログのサイズも算出されます。
しかもこの大きさの計算は、ダイアログオブジェクトが創生される前に行われるため、フォントを指定したあと、独自で再配置をしなければなりません。この計算ロジックは非常にややこしいものです。


※VBのMsgBox関数(またはAPIMassegeBox関数)内部で行われていると思われる手順(フックしてSpyで調べました)
1.MSGの文字数/ボタンの数/アイコンの有無により、ダイアログの大きさの算出・各オブジェクトの配置位置の算出
2.ダイアログ本体を創生
3.ボタンをダイアログ内部に創生(複数のボタンが存在するとき、左側のボタンから創生)
4.アイコンがあるならアイコンを創生
5.メッセージを創生
6.ボタンにフォーカスをセット
7.画面に表示する(サンプルではここで操作しています)
という順序のようです。


サンプルは、画面に表示する直前にフォントを指定しています。上記で述べたとおり、各オブジェクトはすでにできあがってしまっているので、再配置が必要になります。(サンプル内のsetResize関数を作りこんでください)


以下を標準モジュールに貼り付けて、Sub Mainから実行するようにしてください。
[myMsgBox関数]がオリジナルMsgBoxを呼ぶための関数です。



Option Explicit

Public Const WH_CBT = 5

'太文字([400/700]にしているけど、フォントによって違うかも?)
Public Enum MY_BOLD
  MYB_FLASE = 400
  MYB_TRUE = 700
End Enum
'斜体
Public Enum MY_ITALIC
  MYI_FLASE = 0
  MYI_TRUE = 1
End Enum
'下線
Public Enum MY_UNDERLINE
  MYU_FLASE = 0
  MYU_TRUE = 1
End Enum
'取消し線
Public Enum MY_STRINKEOUT
  MYS_FLASE = 0
  MYS_TRUE = 1
End Enum


Public Const HCBT_ACTIVATE = 5 ' ウィンドウがこれからアクティブになる通知メッセージ

Public Const WM_SETFONT = &H30 'フォントを指定
Public Const WM_GETFONT = &H31 'テキストボックス、ラベル等が現在使っているフォントのハンドル

Public Const LF_FACESIZE = &H20
Public Const POINT_PER_INCH = 72
Public Const LOGPIXELSY = 90 '縦方向の1論理インチあたりのピクセル数

Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = (-1)
Public Const HWND_NOTOPMOST = (-2)
Public Const SWP_NOSIZE = &H1&
Public Const SWP_NOMOVE = &H2&
Public Const SWP_NOZORDER = &H4&
Public Const SWP_NOREDRAW = &H8&
Public Const SWP_NOACTIVATE = &H10&
Public Const SWP_FRAMECHANGED = &H20&
Public Const SWP_SHOWWINDOW = &H40&
Public Const SWP_HIDEWINDOW = &H80&
Public Const SWP_NOCOPYBITS = &H100&
Public Const SWP_NOOWNERZORDER = &H200&
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER


Public Type LOGFONT
 lfHeight     As Long 'キャラクタの高さ
 lfWidth      As Long 'キャラクタの幅(0 で標準的プロポーション)
 lfEscapement   As Long '相対的出力角度(単位:1/10度)
 lfOrientation   As Long '回転角度(単位:1/10度)
 lfWeight     As Long 'キャラクタの線幅(FW_BOLD, FW_NORMAL)
 lfItalic     As Byte 'イタリックの時 Chr$(1)、通常 Chr$(0)
 lfUnderline    As Byte 'アンダーライン付きの時 1
 lfStrikeOut    As Byte '横線付きの時 1
 lfCharSet     As Byte 'キャラクタセットの指定
 lfOutPrecision  As Byte '常に OUT_DEFAULT_PRECIS = 0
 lfClipPrecision  As Byte ' 同上
 lfQuality     As Byte 'DEFAULT_QUALITY, DRAFT_QUALITY, PROOF_QUALITY
 lfPitchAndFamily As Byte 'DEFAULT_PITCH,FIXED_PITCH, VAIABLE_PITCH
 lfFaceName    As String * LF_FACESIZE 'タイプフェース名
End Type

Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByRef wParam As Long, ByRef lParam As Any) As Long
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long


Private mHookProcWnd  As Long 'フックプロセスハンドル
Private mFontHandle   As Long '作成したフォントハンドル

Public Sub Main()
  Call myMsgBox("鈴木 宗○", vbOKCancel Or vbQuestion)
End Sub

'メッセージボックスの初期設定
Public Function myMsgBox( _
        inPrompt As String _
        , Optional inButtons As VbMsgBoxStyle = vbOKOnly _
        , Optional inTitle As String = "vs 辻本 清○" _
        , Optional inHelpFile _
        , Optional inContext _
        ) As VbMsgBoxResult
  'フック
  mHookProcWnd = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, App.hInstance, App.ThreadID)
  
  'メッセージボックスを呼ぶ
  myMsgBox = MsgBox(inPrompt, inButtons, inTitle, inHelpFile, inContext)
  
  'メッセージボックスで作成されたフォントを削除する
  Call delFont
End Function

'フック関数
Private Function MsgBoxHookProc _
    (ByVal nCode As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
  
  Static staFlg  As Boolean 'ワーキングフラグ
  
  'システムがウィンドウをアクティブ化しようとしている
  If nCode = HCBT_ACTIVATE Then
    If staFlg Then
      Exit Function
    End If
    staFlg = True
    
    'フォントを設定する
    Call setFont(wParam, 30, MYB_TRUE, MYI_TRUE, MYU_TRUE, MYS_TRUE)
    
    'オブジェクトのリサイズ
    Call setResize(wParam)
    
    Call UnhookWindowsHookEx(mHookProcWnd)
    staFlg = False
  End If
  ' フック関数の継続を中止
  MsgBoxHookProc = False
End Function

Private Sub setFont( _
    inOwnerWnd As Long, _
    Optional ByVal inFontSize As Single = -1, _
    Optional ByVal inBold As MY_BOLD = MYB_FLASE, _
    Optional ByVal inItalic As MY_ITALIC = MYI_FLASE, _
    Optional ByVal inUnderLine As MY_UNDERLINE = MYU_FLASE, _
    Optional ByVal inStrikeOut As MY_STRINKEOUT = MYS_FLASE _
    )

  Dim udtLOGFONT As LOGFONT
  Dim lngDC    As Long
  Dim lngWk    As Long
  Dim lngMsgWnd  As Long 'メッセージボックスのメッセージ部分のハンドル
  
  
  'すでに作成済みのフォントを削除
  Call delFont
  
  'メッセージボックスの中の、メッセージ部分のハンドルを得る
  lngMsgWnd = getWndMsg(inOwnerWnd)
  
  'デバイスコンテキストを得る
  lngDC = GetDC(lngMsgWnd)
  
  '現在のフォントのハンドルを取得
  lngWk = SendMessage(lngMsgWnd, WM_GETFONT, 0, 0&) And &HFFFF&
  
  ' フォント属性を取得
  Call GetObject(lngWk, Len(udtLOGFONT), udtLOGFONT)
  
  '新しい設定を行う
  With udtLOGFONT
    'フォントサイズ/太字/斜体/下線/取消し線
    If inFontSize > 0 Then
      .lfHeight = inFontSize * (GetDeviceCaps(GetDC(inOwnerWnd), LOGPIXELSY) / POINT_PER_INCH) * (udtLOGFONT.lfHeight / Abs(udtLOGFONT.lfHeight))
    End If
    .lfWeight = inBold
    .lfItalic = inItalic
    .lfUnderline = inUnderLine
    .lfStrikeOut = inStrikeOut
  End With
  
  '論理フォントの作成
  mFontHandle = CreateFontIndirect(udtLOGFONT)
  'DCへの関連付け
  Call SelectObject(lngDC, mFontHandle)
  'フォントを指定
  Call SendMessage(ByVal lngMsgWnd, ByVal WM_SETFONT, ByVal mFontHandle, 0&)

End Sub

'フォントオブジェクトの削除
Private Sub delFont()
  If mFontHandle <> 0& Then
    Call DeleteObject(mFontHandle)
    mFontHandle = 0
  End If
End Sub

'メッセージボックスの中の、メッセージ部分のハンドルを得る
Private Function getWndMsg(inWnd As Long) As Long
  Dim lngWnd1 As Long
  Dim lngWnd2 As Long
  
  'メッセージボックスには「Static」クラスを持つオブジェクトが1個か2個ある
  '1個の時は メッセージ
  '2個の時は 最初のStaticはアイコン/次にメッセージ
  
  lngWnd1 = FindWindowEx(inWnd, 0&, "Static" & vbNullChar, vbNullString)
  lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Static" & vbNullChar, vbNullString)
  
  '2個目が存在していたら2個目、そうじゃなけりゃ1個目のハンドルを返す
  getWndMsg = IIf(lngWnd2 <> 0&, lngWnd2, lngWnd1)
End Function

'オブジェクトのリサイズ
'(ここは作りこまないといけない。計算ロジック大変そう・・・・)
Private Function setResize(inWnd As Long)
  Dim lngWidth  As Long
  Dim lngHeight  As Long
  Dim lngWnd1   As Long
  Dim lngWnd2   As Long
  
  '本当はここで再配置ロジックを行う(ボタン/アイコン/メッセージ)の各ハンドルを得て、サイズを変更
  'ここに載っているのは、あくまでサンプルです
  'ボタン数が2個限定ですのでお間違いないように!!!!!!!!!!!!!!
  
  '画面サイズを取得
  lngWidth = (Screen.Width \ Screen.TwipsPerPixelX)
  lngHeight = (Screen.Height \ Screen.TwipsPerPixelY)
  
  'メッセージボックスを座標(0,0)へ表示/メッセージボックスを画面サイズに表示
  Call SetWindowPos(inWnd, 0, 0, 0, lngWidth, lngHeight, _
           SWP_NOZORDER Or SWP_NOACTIVATE)
  
  'メッセージ
  Call SetWindowPos(getWndMsg(inWnd), 0, 0, 0, lngWidth \ 2, lngHeight \ 2, _
           SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOMOVE)
          
  'ボタン1(大きさそのまま/配置変更)
  lngWnd1 = FindWindowEx(inWnd, 0&, "Button" & vbNullChar, vbNullString)
  Call SetWindowPos(lngWnd1, 0, 0, lngHeight - 50, 0, 0, _
           SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_NOSIZE)
  
  'ボタン2(大きさ変更/配置変更)
  lngWnd2 = FindWindowEx(inWnd, lngWnd1, "Button" & vbNullChar, vbNullString)
  Call SetWindowPos(lngWnd2, 0, lngWidth - 400, lngHeight - 500, 300, 300, _
           SWP_NOZORDER Or SWP_NOACTIVATE)
End Function

一応サンプルを作りました。
やってみて面白かったけど、やはりオリジナルを作ったほうがかなり楽だということを実感しました。

注意:
ここの掲示板は文字がずれるので、図形が壊れます。以下の文章をメモ帳などのテキストエディタにコピって読んでください。

・・・さて本題・・・


※メッセージボックスの構造
┏━━━━━━━━━━━━━━━━┓
┣━━━━━━━━━━━━━━━━┫
┃                ┃
┃ ┏━┓ ┏━━━━━━━━┓ ┃
┃ ┃I┃ ┃MSG_AREA┃ ┃
┃ ┗━┛ ┗━━━━━━━━┛ ┃
┃         ...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング