マンガでよめる痔のこと・薬のこと

エクセルVBA「スピンボタンで小数を扱う」
エクセルVBAの初心者です。
スピンボタンとテキストボックスを組み合わせて使う際、「0.1、0.2・・・1.0、1.1・・・」というような数の増加を表示したいのですが、どのようなコーディングが必要でしょうか。
試行錯誤しておりましたがどうしても出来ませんのでご質問させて頂きます。

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

A 回答 (3件)

スピンポタンのSmallChangeプロパティは、Long型ですから、そのままでは扱えません。


ですから、表示を10分の1にするしかありません。なお、前回の質問も、以下でみれば分かるはずです。

'//フォームモジュール

Private Sub SpinButton1_Change()
 With TextBox1
   TextBox1.Text = Format$(SpinButton1.Value / 10, "0.0")
 End With
End Sub

Private Sub UserForm_Initialize()
With SpinButton1
 .Min = 0  '最小値
 .Max = 100 '最大値
 .SmallChange = 1 '1の場合は本来不要
 .Value = 0 '初期値
'プロパティで設定すれば、上記の4つの項目の設定は不要
  TextBox1.Text = Format$(.Value, "0.0") '初期値が0以外は、本来不要
End With
End Sub
    • good
    • 0
この回答へのお礼

ご回答頂きありがとうございます。
Wendy02様、tinu2000様共に前回の質問もごらん頂きありがとうございました。

お二方のご回答はおおよそ同じ内容と判断致しましたので、先に回答して頂きましたWendy02様のご回答をベストアンサーに致しました。

お礼日時:2010/07/04 18:43

前述の質問の続きと見なして。



UserForm1のコード
---------------------- ここから
Option Explicit
Private Sub UserForm_Initialize()
 With Me.SpinButton1
  .Min = 1
  .Value = .Min
 End With
 Me.TextBox1.Value = Format(Me.SpinButton1.Value / 10, "0.0")
End Sub

Private Sub SpinButton1_Change()
 Me.TextBox1.Value = Format(Me.SpinButton1.Value / 10, "0.0")
End Sub


ThisWorkbook のコード
---------------------- ここから
Option Explicit
Private Sub Workbook_Open()
 UserForm1.Show
End Sub
    • good
    • 0
この回答へのお礼

ご回答頂きありがとうございます。
Wendy02様、tinu2000様共に前回の質問もごらん頂きありがとうございました。

お二方のご回答はおおよそ同じ内容と判断致しましたので、先に回答して頂きましたWendy02様のご回答をベストアンサーに致しました。

お礼日時:2010/07/04 18:43

Me.TextBox1.Value = Me.SpinButton1.Value * 0.1


だと微妙な感じですね
整数の場合 1.0とかが1になっちゃうし・・

これしか思い浮かびません 
    • good
    • 0
この回答へのお礼

ご回答頂きありがとうございます。

確かに、これだと1.0は1になってしまいますね。

お礼日時:2010/07/04 18:38

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

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

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

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

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

QVBAのスピンボタンの値の変更について

VBAを使ってスピンボタンをワークシートに挿入しました。
そこで、皆様にお聞きしたいのですが、スピンボタンに上と下のボタンがありますが、このボタンを押すと値はいくつずつ変わるのでしょうか?
私がスピンボタンを押すと1ずつ変わります。
この1という値はデフォルトなのでしょうか?
もしそうだとすれば、この値を2や3に変更することができる(つまりスピンボタンを押すことにより帰ってくる値が2や3ずつ上下できる)のでしょうか?
VBAの本を読みましたが、このことについては載っていなかったので、どなたか知っている方がおりましたら、教えて下さい。
よろしくお願い致します。

Aベストアンサー

スピンボタンを右クリック
プロパティ
スピンボタンのプロパティ
SmallChange の値が1になっているでしょう。
この値を任意の数にして下さい。(2や3、10など)

Max の値はスピンボタンの値上限
Min の値はスピンボタンの値下限

Qユーザーフォームを表示中にシートの操作をさせるには

ユーザーフォームを表示中にシートの操作をさせる事はできるのでしょうか。
セルへの入力、画面のスクロールなどは、ユーザーフォームからマクロを実行させたり、.hideでユーザーフォームを一時的に隠すなどすればいいのでしょうが、そういう手段をとらないでユーザーフォームを表示中にシートの操作をさせる事はできるのでしょうか。

Aベストアンサー

ユーザフォームの
ShowModalプロパティを
falseにすればよいかと。

QEXCEL VBE ユーザフォームのスピンボタンの増減値

excel2000でVBEにてユーザフォームを作りました。そのフォームの中にスピンボタンがあります。スピンボタンのプロパティsmallchangeにて増減値を変えることができるのは知っているのですが、整数しか選択できないようです。作成した当初はデフォルトの1ずつの増減で問題なかったのですが、0.1ずつ増減させる必要が出てきました。どのようにすればよいのでしょうか。excel97なら以下のサイトに方法がかかれていますが、当方excel2000な上に、記述された内容が理解できません。
http://support.microsoft.com/kb/151498/ja

よろしくお願いいたします。

Aベストアンサー

値を表示したいコントロール.value=スピンボタン.value / 10
というコードを書くよう提案したのは、スピンボタンのValueは整数値に限られているからです。
ここでやっていることは、スピンボタンの値が585のとき、値を表示したいコントロールの値は58.5ということにしましょうということです。

したがって、値を表示したいコントロールのChangeイベントでは、
スピンボタン.value = 値を表示したいコントロール.value * 10
としないと、スピンボタンの値が、決めたルールに従ったように変わりません。

Qexcel VBA スピンボタンの値をジャンプ

いつもお世話になります。

コードで、スピンボタンの値をC4セルに入れて変化させています。

下記やりたいことに対して、コードにどのような編集を加えればいいかアドバイスをお願いいたします。

◆やりたいこと
C4セルに任意の数字を手入力⇒enterボタンを押した後に、スピンボタンの値をその数字がら追従して変化させたい。
たとえば、スピンボタンで11⇒12⇒13と変化させているところで、C4セルに77と入力した後にスピンボタンを押すと、78⇒79⇒80と変化できるようにさせたいです。

'◆スピンボタンコード
Private Sub SpinButton1_Change()
Range("C4").Value = SpinButton1.Value
SpinButton1.Min = 1
End Sub

Aベストアンサー

手順:
1.現在の「スピンボタンのコード」を消して白紙に戻します
2.デザインモードでスピンボタンを右クリックしてプロパティを表示します
 LinkedCellに Sheet1!C4 と記入
 Minに 1 を記入
3.デザインモードを解除して使います

スピンボタンをアップダウンすれば,C4の値が変化します
C4に任意の値を記入すれば,その値からまたアップダウンします。





#何かの理由でどうしてコードで制御したいなら,プロパティでLinkedcellは設定せず,changeイベントはヤメにして

Private Sub SpinButton1_SpinDown()
Range("C4") = Application.Max(1, Range("C4") - 1)
End Sub

Private Sub SpinButton1_SpinUp()
Range("C4") = Range("C4") + 1
End Sub

などのようにしておくような方法もあります。

Qエクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?

エクセルのVBAでユーザーフォームの中に
テキストボックスとラベルがあります。

ラベルの縦幅とテキストボックスの縦幅は
同じです。(文字1行分くらい)

そのテキストボックスの左隣にラベルを置いて、
項目名的なものを表示させたいと思うのですが
ラベルの値が上に寄っているので、垂直方向に
中央揃えさせたいのですが、設定の仕方が
分からず困っています。

ちなみにエクセルはXPで、VBAは詳しくありません。
詳しくないけど調べながらちょっとずついろいろ
作業しています。

どうぞよろしくお願いします。

Aベストアンサー

文字の上下中央設定は、確かにできませんね。
代案ですが、次のような操作はいかがでしょうか。

1.双方を選択した状態でプロパティを表示し、AutuSize の値を True にする。
2.前回のようにコントロールの位置を上下中央で揃える。
3.各コントロールの長さ(幅)や文字サイズを調整する。

QExcelVBAでテキストボックスの表示形式を小数点第二位まで表示する方法

Excelのプログラムで、テキストボックスに例えば、「10.00」や「10.50」など小数点第二位まで0であっても表示させる方法はありませんか?
あまり複雑になるようなら特に必要なプログラムではないのですが。

回答よろしくお願いします。

Aベストアンサー

値の元は何処からですか?

自分自身ですか?
値の元が違うなら、
No2さんが答えたように、

TextBox2.Text = Format(TextBox1.Text, ""#."#0")
ですが、自分自身で入力が終わってフォーカスが移動した時などなら

Private Sub TextBox1_LostFocus()
TextBox1.Text = Format(TextBox1.Text, "#.#0")
End Sub

こうすることで、出来ます。

ただし、この #.#0は、
0の場合→ .00 となり
0.567822 → .56 となります。

0の場合→ 0.00
0.567822 → 0.56 としたい場合は、
0.00を指定します。


TextBox1.Text = Format(TextBox1.Text, "0.00")

QEXCEL あるセルに数字が入力されれば既存マクロ実行させたい

ボタン等のグラフィックオブジェクトのマクロ実行は簡単なのですが、
ある位置のセルにデーターが入力されれば、
既存のマクロを自動実行させることできますか?

Aベストアンサー

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
if Range(ある位置) <>"" then call 既存のマクロ名
End Sub

ある位置と既存のマクロ名を変更して使ってみてください。
あと このVBAは 操作するワークシートのほうに記述します。

QVBA コンボボックスで選んだ値を取得するには

ユーザーフォーム上のコンボボックスから値を選択し、その値を変数として使いたいのですが、うまくいきません。

コンボボックスのコードで
Private Sub ComboBox1_Change()
moji1 = ComboBox1.Text
Range("A1").Value = moji1
のようにすれば、コンボボックスから値を選んだ時点でA1セルにその値をコピーできるのですが、同じユーザーフォーム上にあるコマンドボタンをクリックして実行する「マクロ1」にてこのmoji1という変数を使いたいのです。

マクロ1にて、上記と同じ
Range("A1").Value = moji1
というコードを記述しても、ユーザーフォームで選択した値が消えており、empty値となってしまいます。

原因をご存知の方はお教えください。

Aベストアンサー

原因については下記を参考にしてください。
http://pc.nikkeibp.co.jp/pc21/special/2007_gosa/eg5.shtml

Qエクセルでスピンボタンとスクロールバーについて

エクセルでスピンボタンとスクロールバーについて
エクセル2000です。
フォームのスピンボタンとスクロールバーをワークシート上に配置した場合、両者ともほぼ同じ働きをしてくれます。
ところが、大きな違いが有ります。
スピンボタンは上向き▲で数値が大きくなっていきます。これは感覚的にしっくりきます。
ところが縦向きのスクロールバーは上向き▲で数値が逆に小さくなっていきます。これはちょっと違和感があります。
それなら、スピンボタンを使えばいいだけのことと言われそうですが、スピンボタンにはバーがないのでスライドさせて数値を動かすことができないのでスクロールバーを使いたいのです。
もちろん数式を用いて、セルの表示上でそうなるようにはできますが、それではリンク先セルに直接数値を入力ができなくなり不便です。
スクロールバーで上向き▲で数値が大きくなるような設定にはできないのでしょうか?

スクロールバーを縦ではなく横向きに配置すれば右スクロールで数値が増え、数直線と同じでしっくりくるのですが、レイアウトの都合で縦向きに配置したいのです。
わがままな質問ですみません。
よろしくお願いします。 (o。_。)oペコッ.

(なお、同じ質問を1時間ほど前に投稿したつもりだったのですが、なぜか反映されていないので再度質問いたしました。もし二重になっていたら申し訳ありません。)

エクセルでスピンボタンとスクロールバーについて
エクセル2000です。
フォームのスピンボタンとスクロールバーをワークシート上に配置した場合、両者ともほぼ同じ働きをしてくれます。
ところが、大きな違いが有ります。
スピンボタンは上向き▲で数値が大きくなっていきます。これは感覚的にしっくりきます。
ところが縦向きのスクロールバーは上向き▲で数値が逆に小さくなっていきます。これはちょっと違和感があります。
それなら、スピンボタンを使えばいいだけのことと言われそうですが、スピンボタンにはバ...続きを読む

Aベストアンサー

マクロなら、こうなります。
こちらは、スクロールそのものには対応していません。理由は、イベントだから、クリックしている間は、マクロは停止されます。

(以下は、Max を100 と設定しています)

Sub スクロール1_Change()
  With ActiveSheet.ScrollBars(1)
   Range("B10").Value = .Max - .Value
  End With
End Sub

セルの表示なら、どこか見えない所に、LinkedCell(リスクするセル) を置いて、

見える場所にセルに、以下のように置けば、増減は逆になります。
 =100-A100 ←LinkedCell

もちろん、コントロールツールなら、SmallChangeプロパティを、-1 にすればよいはずでしたが、フォームは、負の数は設定できないようです。

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ランキング