Excel VBA質問箱 IV

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

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


56838 / 76732 ←次へ | 前へ→

【24637】Re:HtmlHelp関数の構文追加質問おねがいします
回答  bykin  - 05/4/29(金) 11:37 -

引用なし
パスワード
   こんにちわ。もうみてへんかな?

>開いてみたのですが、圧縮(ZIP形式)フォルダは無効であるか、または
>壊れています、となります。

ダウンロードに失敗したんやと思うよ。こっちではちゃんとDLできてます。

>VBからAPIのCall方法を勉強されることをお勧めします。

同感。VBからの使い方をご存知ないみたいやね・・・
TypeとDeclareくらいはヘルプで確認してみてな。

DLしたクラスモジュールはめっちゃコードが多いんで、そのままではわかりにくいし、
VB用なんで、VBAで使うとそのままではエラーが出るさかいに、
ポップアップの部分だけ抽出・単純化して、エクセルのVBAで使えるように変更して
みました。

シートを右クリックしたらポップアップが表示されます。

'シートモジュール=================================================================

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  Dim PopupHelp As New clsPopup
  
  PopupHelp.ShowPopup "これはテスト用の表示です。"
  Cancel = True
End Sub


'クラスモジュール(モジュール名:clsPopup)=======================================

Private Const HH_DISPLAY_TEXT_POPUP = &HE

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Type tagHH_POPUP
  cbStruct As Integer
  hinst As Long
  idString As Long
  pszText As String
  pt As POINTAPI
  clrForeground As Long
  clrBackground As Long
  rcMargins As RECT
  pszFont As String
End Type

Private Declare Function HtmlHelpTextPopup Lib "hhctrl.ocx" _
  Alias "HtmlHelpA" _
  (ByVal hwnd As Long, _
  ByVal lpHelpFile As String, _
  ByVal wCommand As Long, _
  ByRef dwData As tagHH_POPUP) As Long

Private Declare Function GetCursorPos Lib "user32" _
  (ByRef lpPoint As POINTAPI) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

Public Sub ShowPopup(ByRef PopupText As String)
  Dim pPoint As POINTAPI
  Dim hPopup As tagHH_POPUP
  Dim rRect As RECT
  Dim hWnd As Long
  
  GetCursorPos pPoint
  
  With rRect
   .Bottom = -1
   .Left = -1
   .Right = -1
   .Top = -1
  End With
  
  With hPopup
   .cbStruct = Len(hPopup)
   .clrForeground = vbBlack
   .clrBackground = vbYellow
   .idString = 0
   .pszText = PopupText
   .pt = pPoint
   .rcMargins = rRect
   .pszFont = "MS 明朝, 12"
  End With
  
  hWnd = GetActiveWindow()
  HtmlHelpTextPopup hWnd, vbNullString, HH_DISPLAY_TEXT_POPUP, hPopup
   
End Sub

あとは元のクラスモジュールを解析してみておくれやす。
ほな。
0 hits

【24615】HtmlHelp関数の構文教えて下さい nobuyuki 05/4/28(木) 13:40 質問
【24617】Re:HtmlHelp関数の構文教えて下さい ちゃっぴ 05/4/28(木) 16:04 回答
【24626】Re:HtmlHelp関数の構文教えて下さい bykin 05/4/28(木) 23:01 回答
【24631】Re:HtmlHelp関数の構文教えて下さい nobuyuki 05/4/29(金) 3:37 お礼
【24630】HtmlHelp関数の構文追加質問おねがいします nobuyuki 05/4/29(金) 3:26 質問
【24633】Re:HtmlHelp関数の構文追加質問おねがいし... ちゃっぴ 05/4/29(金) 7:10 回答
【24636】Re:HtmlHelp関数の構文追加質問おねがいし... nobuyuki 05/4/29(金) 10:34 お礼
【24637】Re:HtmlHelp関数の構文追加質問おねがいし... bykin 05/4/29(金) 11:37 回答
【24639】Re:HtmlHelp関数の構文追加質問おねがいし... nobuyuki 05/4/29(金) 17:22 お礼

56838 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free