[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ウェブブラウザの全面にラベルを配置したい』（天国耳）
こんにちは、よろしくお願いいたします。
ユーザーフォーム上にウェブブラウザを配置し、その上(前面)にラベルを配置しました。
VBE上ではウェブブラウザの前面にラベルが配置されてるのですが、いざユーザーフォーム
を表示したら、ウェブブラウザの下にラベルが隠されてしまいます。
ユーザーフォーム起動時に
MeLabel1.ZOrder (0)
としても同じでした。
ウェブブラウザの前面にラベルを配置するのは出来ないのでしょうか？
なぜこんなことをしてるのかと言いますと、
ラベルをウェブブラウザの上に配置しBackStyleをfmBackStyleTransparentにして透明にし、ラベルの
MouseMoveイベントでウェブブラウザをスクロールさせたいからです。
ラベルをウェブブラウザから離れたところに配置した場合はきちんと動作しております。
＜ 使用 Excel：Excel2007、使用 OS：WindowsVista ＞
あとは、APIを駆使するしか手が無いかもです。または、普通にVB.NETで考えるとか？
（???） 2017/05/25(木) 15:01
まず、ラベル、テキストボックス等、透過できるコントロールはウィンドウハンドルを持たないので、最前面に切り替える要求を出せません。フレームやリストボックスだと、透過対応していません。
ウィンドウハンドルが無いので、クラスで探せば実現できるかもですが、まずUserFormのクラス名はThunderDFrameなので、このあたりを手がかりに、子クラスを探す…のかなぁ？、と思います。しかし、実例は見つけられませんでした。
別案で、フレームのような透過対応していないコントロールを、無理矢理透過させては？、というのも考えましたが、これも実例が見つかりませんでした。
更に別案ですが、こうなったら新規透明ウィンドウを作成し、これで画面を覆ってしまって、イベントを拾うとかはいかがですか？ これもサンプル無しですが。
諦めて、素直にスクロールバーで操作するのが良いのではないかと思いました。
（???） 2017/05/25(木) 16:10
エクセル自体やユーザーフォームを透明化するAPIは見つかりましたが、コントロール(Frame)のハンドルを取得するサンプルは見つかりませんでした。
素直に、二つのスピンボタンで上下させるようにします。いろいろ考えていただきありがとうございました。
（天国耳） 2017/05/25(木) 16:18
>二つのスピンボタンで上下
二つのスピンボタンで上下左右、でした。失礼しました｡ （天国耳） 2017/05/25(木) 16:29
ウェブブラウザコントロールにはMouseMoveやMouseDown、MouseUp、KeyDown、KeyUpイベントも 無いんですね・・・。不便です。
やりたいことはスピンボタンで解決済みです。 （天国耳） 2017/05/25(木) 17:43
動きがぎこちないですが、ラベルでマウスカーソルを動かすことによってウェブブラウザを左右上下にスクロールする
ことが出来ました。ネット上のコードを一部拝借しております。
'ユーザーフォーム
Dim kaiX As Single
Dim kaiY As Single
Dim shuX As Single
Dim shuY As Single
Dim xSa As Single
Dim Ysa As Single
Dim flg As Boolean
'カーソル移動の場合
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If flg = False Then
GetCursorPos MoP
kaiX = MoP.X
kaiY = MoP.Y
flg = True
Else
GetCursorPos MoP
shuX = MoP.X
shuY = MoP.Y
xSa = shuX - kaiX
Ysa = shuY - kaiY
Me.WebBrowser1.Document.parentWindow.scrollby CInt(xSa), CInt(Ysa)
flg = False
End If
End Sub
'ドラッグ＆ドロップの場合
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button <> 1 Then Exit Sub
GetCursorPos MoP
kaiX = MoP.X
kaiY = MoP.Y
End Sub
Private Sub Label1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button <> 1 Then Exit Sub
GetCursorPos MoP
shuX = MoP.X
shuY = MoP.Y
xSa = shuX - kaiX
Ysa = shuY - kaiY
Me.WebBrowser1.Document.parentWindow.scrollby CInt(xSa), CInt(Ysa)
End Sub
Private Sub UserForm_Initialize()
kaiX = 0 shuX = 0 kaiY = 0 shuY = 0 flg = False End Sub
'標準モジュール
'SampleNo=103 WindowsXP VB6.0(SP5) 2002.05.10
'マウスカーソルの位置を設定する（P389)
Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long
'位置座標を受け取る構造体
Public Type POINTAPI
X As Long
Y As Long
End Type
'現在のマウスカーソルの位置座標を取得する（P387)
Public Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Public MoP As POINTAPI '現在のマウスポインターの位置座
（天国耳） 2017/05/25(木) 19:04
'ユーザーフォーム
Dim barht As Single
Dim xa As Integer
Dim ya As Integer
Dim ut As Single
Dim ul As Single
Dim lx As Single
Dim ly As Single
Dim lwd As Single
Dim lht As Single
Dim flg As Boolean
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then flg = Not flg
If flg = True Then
Me.Label1.BackColor = vbBlue
Else
Me.Label1.BackColor = vbWhite
End If
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim xposi As Integer
Dim yposi As Integer
If flg = False Then Exit Sub
GetCursorPos MoP
xa = MoP.X * 0.75
ya = MoP.Y * 0.75
ul = Me.Left
ut = Me.Top
Select Case xa
Case ul + lx To ul + lx + lwd / 3
xposi = -20
Case ul + lx + lwd / 3 To ul + lx + lwd * 2 / 3
xposi = 0
Case Else
xposi = 20
End Select
Select Case ya - barht 'ﾕｰｻﾞｰﾌｫｰﾑのﾀｲﾄﾙﾊﾞｰの高さ分調整
Case ut + ly To ut + ly + lht / 3
yposi = -20
Case ut + ly + lht / 3 To ut + ly + lht * 2 / 3
yposi = 0
Case Else
yposi = 20
End Select
Me.WebBrowser1.Document.parentWindow.scrollby xposi, yposi
End Sub
Private Sub UserForm_Initialize()
flg = False Me.Label1.Caption = "スクロールは" & vbCrLf & "ここをクリック" Me.Label1.ForeColor = vbBlue lx = Me.Label1.Left ly = Me.Label1.Top lwd = Me.Label1.Width lht = Me.Label1.Height barht = Me.Height - Me.InsideHeight 'ﾕｰｻﾞｰﾌｫｰﾑのﾀｲﾄﾙﾊﾞｰの高さ End Sub
'標準モジュール
'SampleNo=103 WindowsXP VB6.0(SP5) 2002.05.10
'マウスカーソルの位置を設定する（P389)
Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long
'位置座標を受け取る構造体
Public Type POINTAPI
X As Long
Y As Long
End Type
'現在のマウスカーソルの位置座標を取得する（P387)
Public Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Public MoP As POINTAPI '現在のマウスポインターの位置座標
（天国耳） 2017/05/28(日) 19:47
前回値より右か左かで判断するか、またはラベル領域を1つの画面と見立てて、ラベル内のマウス位置の比率に合わせてブラウザのスクロールを決めてみてはいかがでしょうか。つまり、マウスをラベルの右端寄りに動かせば、ブラウザも右端寄りを表示する感じ。Moveより、Clickで拾っても良いかも？（スクロールなら、押しっぱなしでマウスを動かせば良いだけ）
（???） 2017/05/29(月) 09:26
またはラベル領域を1つの画面と見立てて、ラベル内のマウス位置の比率に合わせてブラウザのスクロールを決めてみてはいかがでしょうか。
こちらの方向で考えてみました。
WebBrowserで表示しているページの幅や高さを取得、スクロール量を算出、というのがきちんとできていないとは思いますが、曲がりなりにも
それっぽいのは出来ました。
下記が再現手順です。
下記のコードをVBSとして保存します。IEでウェブページを表示している状態で、リンクされている画像ファイルのパスを取得しテキストファイル
に書き出します。
Dim FSO
Dim w
Dim MyShell
Dim myttl
Dim myinhtm
Dim sp
Dim spB
Dim spD
Dim i
Dim myf
Dim mydic
Dim mykaku
Dim cnt
dim tx
Dim txtpath
Dim txtstr
Dim gdic
cnt = 0
Set mydic = CreateObject("Scripting.Dictionary")
mydic.Add "gif", "gif"
mydic.Add "jpg", "jpg"
mydic.Add "jpeg", "jpeg"
mydic.Add "png", "png"
mydic.Add "bmp", "bmp"
Set gdic = CreateObject("Scripting.Dictionary")
Set MyShell = CreateObject("Shell.Application")
txtstr = ""
For Each w In MyShell.Windows
If UCase(Right(w.FullName, 12)) = "IEXPLORE.EXE" Then
myttl = w.Document.Title
myinhtm = w.Document.body.innerHTML
sp = Split(myinhtm, """")
For i = 0 To UBound(sp)
myf = sp(i)
If left(Trim(myf),4)="http" Then
spB = Split(myf, ".")
mykaku = LCase(spB(UBound(spB)))
If mydic.exists(mykaku) Then
If gdic.exists(myf) Then
else
gdic.Add myf, myf
cnt = cnt + 1
end if
End If
Erase spB
End If
Next
Erase sp
sp = Split(myinhtm, "=")
For i = 0 To UBound(sp)
If sp(i) <> "" Then
fpath = Split(sp(i), ">")(0)
If left(fpath,4)= "http*" Then
spB = Split(fpath, ".")
mykaku = LCase(spB(UBound(spB)))
If mydic.exists(mykaku) Then
If gdic.exists(myf) Then
else
gdic.Add fpath, fpath
cnt = cnt + 1
end if
End If
End If
End If
Erase spB
Next
Erase sp
End If
Next
If cnt <> 0 then
txtstr = join(gdic.Keys,vbcrlf)
txtpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
& "\" & ima & ".txt"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.Fileexists(txtpath) Then
Wscript.Echo txtpath & VbCrlf & "は既に存在"
Else
Set tx = FSO.CreateTextFile(txtpath, True)
tx.WriteLine txtstr
tx.Close
set tx = nothing
End If
Else
'画像無し
End If
set FSO = nothing
Set MyShell = Nothing
mydic.RemoveAll
Set mydic = Nothing
gdic.RemoveAll
Set gdic = Nothing
Wscript.Quit
Function ima()
dim hiduke dim jikoku hiduke = replace(cstr(date),"/","") hiduke = Right(hiduke,len(hiduke)-2) jikoku = replace(cstr(time),":","") if len(jikoku) = 5 then jikoku = "0" & jikoku ima = hiduke & jikoku end function
ブックにユーザーフォームを作成し、テキストボックス一つ、ラベル一つ、ウェブブラウザ一つ、
スピンボタン一つ、コマンドボタン二つを配置し、下記のコードをVBEに記述します。
Dim xa As Integer
Dim ya As Integer
Dim ut As Single
Dim ul As Single
Dim lht As Single
Dim lwd As Single
Dim ll As Single
Dim lt As Single
Dim lr As Single
Dim lb As Single
Dim scht As Single
Dim scwd As Single
Dim barht As Single
Private flg As Boolean
Private gflg As Boolean
'コマンドボタン
Private Sub CommandButton1_Click()
Dim mypath As String
'テキストボックスからURL取得
mypath = Me.TextBox1.Value
If mypath = "" Or Left(mypath, 4) <> "http" Then Exit Sub
With Me.WebBrowser1
.Navigate mypath
Do While .Busy Or .ReadyState <> 4
DoEvents
Loop
Do While (.Document.ReadyState <> "complete")
DoEvents
Loop
.Document.body.runtimeStyle.Zoom = "100%"
scht = .Document.body.ScrollHeight
scwd = .Document.body.ScrollWidth
End With
gflg = True
'Me.Label1.Picture = LoadPicture(mypath) 'ネット上の画像は表示できないようです。
End Sub
'スピンボタン
'ズームアウト
Private Sub SpinButton1_SpinDown()
Dim myzoom As Integer myzoom = Replace(CStr(Me.WebBrowser1.Document.body.runtimeStyle.Zoom), "%", "") * 1 If myzoom <= 10 Then Exit Sub myzoom = myzoom - 10 Me.WebBrowser1.Document.body.runtimeStyle.Zoom = myzoom & "%" End Sub
'ズームイン
Private Sub SpinButton1_SpinUp()
Dim myzoom As Integer myzoom = Replace(CStr(Me.WebBrowser1.Document.body.runtimeStyle.Zoom), "%", "") * 1 myzoom = myzoom + 10 Me.WebBrowser1.Document.body.runtimeStyle.Zoom = myzoom & "%" End Sub
Private Sub CommandButton2_Click()
Call cls End Sub
'フラグ切替え/マウス移動によるスクロールを有効化
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If gflg = False Then Exit Sub
If Button = 1 Then flg = Not flg
If flg = True Then
Me.Label1.BackColor = vbBlue
ut = Me.Top
ul = Me.Left
lr = ul + ll + lwd
lb = ut + lt + lht
Else
Me.Label1.BackColor = vbWhite
End If
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim xposi As Single
Dim yposi As Single
If flg = False Then Exit Sub
If gflg = False Then Exit Sub
'マウスカーソル位置
GetCursorPos MoP
xa = MoP.X * 0.75
ya = MoP.Y * 0.75 - barht * 0.75
'パーセント取得
xposi = 1 - (lr - xa) / lwd
yposi = 1 - (lb - ya) / lht
'WebBrowserをスクロール
Me.WebBrowser1.Document.Script.setTimeout "javascript:scrollTo(" & scwd * xposi & "," & scht * yposi & ");", 100
End Sub
Private Sub UserForm_Initialize()
flg = False gflg = False Me.Label1.Caption = "ｽｸﾛｰﾙは" & vbCrLf & "ここをｸﾘｯｸ" Me.Label1.ForeColor = vbBlue barht = Me.Height - Me.InsideHeight 'ﾕｰｻﾞｰﾌｫｰﾑのﾀｲﾄﾙﾊﾞｰの高さ lwd = Me.Label1.Width lht = Me.Label1.Height ll = Me.Label1.Left lt = Me.Label1.Top Me.CommandButton1.Caption = "画像表示" Me.CommandButton2.Caption = "閉じる" End Sub
Option Explicit
'標準モジュール
'SampleNo=103 WindowsXP VB6.0(SP5) 2002.05.10
'マウスカーソルの位置を設定する（P389)
Public Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long
'位置座標を受け取る構造体
Public Type POINTAPI
X As Long
Y As Long
End Type
'現在のマウスカーソルの位置座標を取得する（P387)
Public Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Public MoP As POINTAPI '現在のマウスポインターの位置座標
Sub cls()
If Workbooks.Count = 1 Then
ThisWorkbook.Saved = True
Application.Quit
Else
ThisWorkbook.Close , False
End If
End Sub
Private Sub Workbook_Open()
UserForm1.Show 0
End Sub
ブックを起動しユーザーフォームが表示されたら、VBSで作成したテキストファイルの画像ファイルのパスを一行
テキストボックスに貼り付けます。
そして、「画像表示」コマンドボタンをクリックしWebBrowserに画像を表示させます。
画像が表示されたら、スピンボタンで画像を大きくします。
ラベルを左クリックしたら、ラベルが青くなり、ラベル上でマウスを動かしたらWebBrowserが合わせてスクロール
します。
ラベルの左上が基点になり(0パーセント)、右に行くほど右にスクロールし、下に行くほど下にスクロールします。
右下が100％です。
ただ、実際には、セルなどに移動割合(xposi、yposi)を書きだすようにしたら100パーセントを超えたりしている
ようですが・・・。そこまで厳密な計算をしてないし、そこまで厳密な数値を求められるのでもないので目を瞑って
ます・・・。)
「閉じる」ボタンクリックでブックを閉じます。
実際のブックは画像パスはVBSではなくVBAでユーザーフォームのリストボックスに格納し、リストボックスで選択
した画像をウェブブラウザに表示するようにしています。今回、再現するために簡略化しています。
一応は動作してますが、厳密にコーディングしてないせいか、ラベルの左上にマウスカーソルがあってもWebBrowser
は左上に戻りきらない、などのずれはあります。もし気が付いた点がございましたらご指摘ください。
（天国耳） 2017/06/01(木) 00:04
URLによる直接画像表示を考えていたようですが、ブラウザで表示なら可能であり、今はそうしていますね？
LoadPictureを使うならば、まず画像をファイルとしてダウンロードして、自PCに持ってきた画像のフルパスを指定しないと駄目でしょう。
（???） 2017/06/01(木) 09:36
>LoadPictureを使うならば、まず画像をファイルとしてダウンロードして、自PCに持ってきた画像のフルパスを指定しないと駄目でしょう。
そうなんですね。同じくLoadPictureを使うImageコントロールでも同じでした。 画像ファイルとしてダウンロードするのは一度WebBrowserで画像を見てから必要に応じてリストボックスから選択してから行うようにしていますが、 一旦全部画像をダウンロードしておいたらラベルに画像を表示し、その画像の上をマウスを移動し、そのポイントに合わせてWebBrowserをスクロ ール、というのが出来ますね。画像のサイズを取得し、ラベルのサイズを変えたらもっとそれっぽく？なりそうです。
これで一応解決とさせていただきます。ありがとうございました。 （天国耳） 2017/06/01(木) 11:03
画像の上でマウスを動かし、そのマウスカーソルがある部分付近を別のコントロールに拡大表示、
という方向にしてみました。
表示用コントロール、スクロール用コントロールともにWebBrowserを使ってみました。
WebBrowserコントロールは元々IEのせいか、MouseMoveイベントはありませんでした。
WEB上の画像をいったんAPIを使ってダウンロードしてからコントロールに表示、という方向に
してみました。
表示用コントロール、スクロール用コントロールともにFrameを使ってみました。
Frameコントロール(以外もですが)はPNGファイルは表示できませんでした。
拡張子がPNGのファイルについては、シートにPicture挿入し、Chartオブジェクトを画像ファイル
として指定のフォルダにExportすることにしました。
また、WEB上の画像は、９０度、あるいは-９０度横に寝ている画像もあります。これでは見にくい
ので、ダウンロードしたあと、PNGの時のようにシートにPicture挿入し、画像を回転させた状態の
ものを画像ファイルとしてExportするようにしました。
これはいったん表示したあとコンボボックスで角度を指定して再度読み込むようにしてあります。
これで大分画像を閲覧しやすくなりました。まあ、画像ビューワソフトを使えばもっと機能の高い
ものはあると思いますが・・・。
ひとつ気付いたのが、PNGファイルをシートにPicture挿入し、画像ファイルとしてExportした場合
は、APIを使ってダウンロードした場合に比べて２倍ほどにサイズ(容量)が大きくなってしまうこと
です。
今回はFrameに表示したい画像をリストボックスから選択した時にネットからDLし、必要に応じて
シートに挿入し画像ファイルとしてExportするようにしてますので個々の画像の重さはさほど問題
になりませんが、試行錯誤の途中で、一旦全画像をシートに挿入→画像ファイルとしてExporという
のをやってみたときは、さすがに途中でフリーズしてしまいました。画像５個ごとにブックを使い
捨てにしても同じでした。
断定はできませんが、PNGファイルでも元の画像ファイルのサイズが1MB以上の場合はシートに挿入
しExportしたら2MB以上になる場合がありました。
一応解決してますのでご報告まで。
（天国耳） 2017/06/05(月) 23:14
元画像が不可逆圧縮形式のPNGでもJPEGでも、「画像」として読み込んだ場合、イメージデータ（おそらくDIB形式という、ベタなバイナリであり、ブック保存すると16進文字列になり更に増大）になるので、ファイルサイズ増加分が元ファイルサイズより、かなり大きくなるのですよ。
ファイルサイズを小さくしたいならば、オブジェクトとしてシートに貼った後、PNGやJPEG形式に変換すると良いでしょう。
が、圧縮画像→展開→再圧縮になるわけで、画質は劣化します。見た目縮小した画像を、見えている寸法に小さくしつつ圧縮形式にする事もできます。
見た目の寸法で圧縮形式に変換した場合、拡大すると見るに堪えない画質になるので、後から拡大したい場合には、この方法は向きません。
（???） 2017/06/06(火) 14:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.