VB最近始めたばかりです。
起動してあるウインドウの全体をjpgなどの画像として取込み、それを保存したいのですが、どうやればいいのかさっぱりわかりません。 
わかりずらい質問の仕方かもしれませんが、もしわかる方がいれば教えてください。お願いします

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

A 回答 (3件)

サンプルです。



クリップボードを使用する方法のサンプルが手元にあったので、それを載せておきます。
クリップボードを使用しない方法は手元にないのですが、todo36さんの載せているサンプルをちょっとだけ改造するときますよ。

※処理の流れ
1.クリップボードにコピー(関数:fucSnapShot)
2.クリップボードの内容を取得
3.保存

※必要な物
フォーム
コマンドボタン
ピクチャボックス

Private Type tagKEYBDINPUT
  wVk         As Integer
  wScan        As Integer
  dwFlags       As Long
  time        As Long
  dwExtraInfo     As Long
  bytUnusedPadding(7) As Byte
End Type
Private Type tagINPUT
  type As Long
  ki  As tagKEYBDINPUT
End Type
Private Const INPUT_KEYBOARD = 1
Private Const VK_SNAPSHOT = &H2C
Private Const VK_LMENU = &HA4&
Private Const KEYEVENTF_KEYUP = &H2
Private Declare Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As tagINPUT, ByVal cbSize As Long) As Long


Private Sub Command1_Click()
  '画面をクリップボードにコピーさせる
  Call fucSnapShot
  
  With Me
    'クリップボードから画像を得る
    .Picture1.Picture = Clipboard.GetData
    
    '画像を保存
    Call SavePicture(.Picture1.Image, "c:\test.bmp")
  End With
End Sub

Sub fucSnapShot()
  Dim inpInfomation(3)  As tagINPUT
  
  ' キー ストロークを作成
  With inpInfomation(0)
    .type = INPUT_KEYBOARD
    .ki.wVk = VK_LMENU
  End With
  With inpInfomation(1)
    .type = INPUT_KEYBOARD
    .ki.wVk = VK_SNAPSHOT
  End With
  With inpInfomation(2)
    .type = INPUT_KEYBOARD
    .ki.wVk = VK_LMENU
    .ki.dwFlags = KEYEVENTF_KEYUP
  End With
  With inpInfomation(3)
    .type = INPUT_KEYBOARD
    .ki.wVk = VK_SNAPSHOT
    .ki.dwFlags = KEYEVENTF_KEYUP
  End With
  
  ' キー ストロークを合成
  Call SendInput(3, inpInfomation(0), Len(inpInfomation(0)))
  
  'Windowsに処理を渡す(クリップボードに画像がわたる)
  DoEvents
End Sub

Private Sub Form_Load()
  With Me
    'フォームの書式設定
    .ScaleMode = vbPixels
    
    'ダミーピクチャボックスの書式設定
    With .Picture1
      .Appearance = 0
      .AutoRedraw = True
      .AutoSize = True
      .BorderStyle = 0
      .Visible = False
    End With
    
    'コマンドボタン
    .Command1.Caption = "実行"
  End With
End Sub

この回答への補足

リファレンスブックを買い調べていたのですが、探し出せないので補足です。
えっと、フォームの取り込みはわかったのですが、たとえば、インターネットエクスプローラなどのウインドウ内の画像の取り込みはどのようにしたら良いかわかりますでしょうか。わかりましたら教えてください、お願いします。

補足日時:2001/12/18 22:58
    • good
    • 0
この回答へのお礼

お礼遅くなりました、すいません。
初心者みたいなものなので、解読に時間がかかってますがとても役に立っております。サンプルプログラムまで書いていただき本当にありがとうございます。

お礼日時:2001/12/17 18:02

No.1の補足です



DesktopHwnd = GetDesktopWindow()

の代わりに

DesktopHwnd = form1.hWnd

とすれば、form1をBMPに保存できます。
    • good
    • 0
この回答へのお礼

補足ありがとうございます。No.1だけでもとても参考になっていたのに、補足までしていただいてとても感謝感激です。ありがとうございます。

お礼日時:2001/12/17 18:12

ずばりなサンプルを見つけました。


何語??

参考URL:http://www.activevb-archiv.de/vb/VBtips/VBtip007 …

この回答への補足

これは、ディスクトップ全体ですよね。これでも良いのですが、フォーム内(ウインドウ内)を画像としてとるにはどうしたら良いのかわかりますか?
それから、ずうずうしいですが日本語で書いてあるところ知っていましたら教えてください。
お願いします

補足日時:2001/12/14 22:43
    • good
    • 0
この回答へのお礼

とても参考になっています。本当にありがとうございました
補足のほうわかりましたら教えてください。お願いします

お礼日時:2001/12/14 22:57

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

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

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

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

Qファイル名「1.jpg ~10.jpg~」のソート

ただ今、エクセルのvbaを使って
複数の写真ファイルを一気に貼り付けてJPEGに変換するプログラムを作っています。
だいたいはできたのですが、一つ壁にぶつかりました。

アルゴリズムは指定したフォルダのファイル名を取得し、それをリスト用のシートに出力し、使用者に必要なファイルを取捨選択してもらうようにしています。


フォルダのファイル名は下記URLのサンプルから使わせていただいています。

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html

しかし、これを使うと、

「1.jpg、2.jpg~10.jpg・・・」のファイル名を取得すると、
「1.jpg、10.jpg、2.jpg・・・」

という風になります。これを回避するには現状「01.jpg、02.jpg~10.jpg・・・」と名前をつけるしかないのですが、不特定多数の人に使わせるので、出来るだけ汎用性を持たせたいと思っています。

例えば


「テスト1-1.jpg、テスト1-2.jpg~テスト1-10.jpg・・・
テスト10-1.jpg、テスト10-2.jpg~テスト10-10.jpg・・・
テスト11-1.jpg、テスト11-2.jpg~テスト11-10.jpg・・・」

というファイル名を上の通りに並べ変えるとしたら、どうすればいいでしょうか?


難しい場合は
「01.jpg、02.jpg~10.jpg・・・」

の時だけでもいいのでよろしくお願いします。

ただ今、エクセルのvbaを使って
複数の写真ファイルを一気に貼り付けてJPEGに変換するプログラムを作っています。
だいたいはできたのですが、一つ壁にぶつかりました。

アルゴリズムは指定したフォルダのファイル名を取得し、それをリスト用のシートに出力し、使用者に必要なファイルを取捨選択してもらうようにしています。


フォルダのファイル名は下記URLのサンプルから使わせていただいています。

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html

しかし、これを使うと、

「1.jpg、2.j...続きを読む

Aベストアンサー

Windows XP 以降、エクスプローラーのファイル表示に使われているソート ルールってことですよね。(マイクロソフトの直観的なソート)

StrCmpLogicalW って API を使ってるっぽいです。

SortByIntuitiveFilename っていう関数を作ってみました。
文字列型の配列にファイル名の一覧を入れておいてこの関数に渡せばソートしてくれます。
一応テスト用のプロシージャ Sub Test() も載せておきます。

Option Explicit

Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 As String) As Long

Sub SortByIntuitiveFilename(ByRef aFiles() As String)
Dim i As Long
Dim j As Long
Dim tmp As String
'Dim minIdx As Long
'Dim maxIdx As Long

'minIdx = LBound(aFiles)
'maxIdx = UBound(aFiles)

For i = LBound(aFiles) To UBound(aFiles)
For j = i To UBound(aFiles)
If StrCmpLogicalW(StrConv(aFiles(i), vbUnicode), StrConv(aFiles(j), vbUnicode)) > 0 Then
tmp = aFiles(i)
aFiles(i) = aFiles(j)
aFiles(j) = tmp
End If
Next
Next

End Sub

Sub test()
Dim strPath As String
strPath = "e:\test"

Dim fso As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Set fso = New Scripting.FileSystemObject
Set fld = fso.GetFolder(strPath)

Dim fileNames() As String
Dim cnt As Long
cnt = fld.Files.Count
ReDim fileNames(cnt - 1)

Dim k As Long
k = 0
Dim f As Scripting.File
For Each f In fld.Files
fileNames(k) = f.Name
k = k + 1
Next

Call SortByIntuitiveFilename(fileNames)

End Sub

Windows XP 以降、エクスプローラーのファイル表示に使われているソート ルールってことですよね。(マイクロソフトの直観的なソート)

StrCmpLogicalW って API を使ってるっぽいです。

SortByIntuitiveFilename っていう関数を作ってみました。
文字列型の配列にファイル名の一覧を入れておいてこの関数に渡せばソートしてくれます。
一応テスト用のプロシージャ Sub Test() も載せておきます。

Option Explicit

Declare Function StrCmpLogicalW Lib "SHLWAPI.DLL" (ByVal lpStr1 As String, ByVal lpStr2 ...続きを読む

Qエクセルテーブルをアクセステーブル取込む

エクセルで作成したテーブルデータを取り込むときに余分に空白のレコードが取り込まれてしまうんですが原因が分かりません。
下記コードで処理してます。




Dim strac As String
Dim strxls As String
Dim strrange As String
Dim strMsg As String

strac = "T_障害票マスタ" 'Accessテーブルを指定します。
strxls = テキスト0 'エクセルファイルを指定します。
strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。
strMsg = "エクセルファイル" & strxls & " を、Accessファイル " & strac & _
"として、データ入力を行います。" & _
"よろしければ、OKをクリックして下さい。" 'MsgBoxのメッセージ

If strxls = "" Then
MsgBox "ファイルを選択して下さい。" 'テキストボックスの確認
Exit Sub
End If


'DoCmd.DeleteObject acTable, strac 'テーブルを削除します。

If MsgBox(strMsg, vbOKCancel, "import") = vbOK Then

'最初のデータをフィールド名として使います。
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _
strac, strxls, True, strrange

MsgBox "インポートは、正常に完了しました。"

End If

Exit Sub

なお取り込むテーブルデータはフィールド行を抜かして常に1レコードだけです。
アクセスでは既存のテーブルに保存してます。
詳しい方お願いします。

エクセルで作成したテーブルデータを取り込むときに余分に空白のレコードが取り込まれてしまうんですが原因が分かりません。
下記コードで処理してます。




Dim strac As String
Dim strxls As String
Dim strrange As String
Dim strMsg As String

strac = "T_障害票マスタ" 'Accessテーブルを指定します。
strxls = テキスト0 'エクセルファイルを指定します。
strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。
strMsg = "エクセルファイル...続きを読む

Aベストアンサー

私の場合
Sub test18()
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "社員1", "C:\Documents and Settings\XXX\My Documents\YYYY.xls", True, "A1:C7"
End Sub
で実行すると見出し除きで(上記エクセルシートの)6行がACCESSにインポートされた。
質問での、ここの定義=strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。
の範囲がデータのない空白行まで含めているのだろう。
チェックしたかどうかも質問に書いてない。まずやるべきこと。
ACCESS側で自動でエクセルの最終行を捉え、上記例でA1:C7の7の文字列を作るのは不可能で、エクセルの世界にACCESSから入り、エクセを開くコードを書いて、エクセルの世界でのEnd(xlUp).Rowのようなことをして割り出さないとならないでしょう。CurrentRegionなどは使えないでしょうから。

私の場合
Sub test18()
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "社員1", "C:\Documents and Settings\XXX\My Documents\YYYY.xls", True, "A1:C7"
End Sub
で実行すると見出し除きで(上記エクセルシートの)6行がACCESSにインポートされた。
質問での、ここの定義=strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。
の範囲がデータのない空白行まで含めているのだろう。
チェックしたかどうかも質問に書いてない。まずやるべきこと。
ACCESS側で自動でエ...続きを読む

Qテキストファイルを正常に取込するには?初心者です

下記の様なテキストファイルを配列に取込したいのですが、ファイル読込み途中で「これ以上ファイルが有りません」エラーとなります。どうしたらよいでしょうか?
ちなみに配列は(14,100)としています。

【読込みしたいテキスト文】改行に↑が入ります
000002,0,0010,,,ABCDEFG,,,00000010,,,,,060420
000004,0,0010,,0,HIJKLMN,000,497009014866,00000550,020201,0000,000,000400,060420

【フォームロード時に取込む】
Private Sub Form_Load()

If Dir(POPFile) = "" Then 'ファイルの存在チェック
'ファイルが無い
NewData '変数の初期設定と画面の表示
TargetRec = 1
MaxRec = 0
lblRec.Caption = "1/新規"

Else

MaxRec = 0 'ファイルが在るのでデータを読み込む
Open POPFile For Input As #1
Do Until EOF(1)
MaxRec = MaxRec + 1
Input #1, POP(1, MaxRec)
Input #1, POP(2, MaxRec)
Input #1, POP(3, MaxRec)
Input #1, POP(4, MaxRec)
Input #1, POP(5, MaxRec)
Input #1, POP(6, MaxRec)
Input #1, POP(7, MaxRec)
Input #1, POP(8, MaxRec)
Input #1, POP(9, MaxRec)
Input #1, POP(10, MaxRec)
Input #1, POP(11, MaxRec)
Input #1, POP(12, MaxRec)
Input #1, POP(13, MaxRec)
Input #1, POP(14, MaxRec)

Loop
Close #1

下記の様なテキストファイルを配列に取込したいのですが、ファイル読込み途中で「これ以上ファイルが有りません」エラーとなります。どうしたらよいでしょうか?
ちなみに配列は(14,100)としています。

【読込みしたいテキスト文】改行に↑が入ります
000002,0,0010,,,ABCDEFG,,,00000010,,,,,060420
000004,0,0010,,0,HIJKLMN,000,497009014866,00000550,020201,0000,000,000400,060420

【フォームロード時に取込む】
Private Sub Form_Load()

If Dir(POPFile) = "" Then 'ファ...続きを読む

Aベストアンサー

>改行に↑が入ります
ということなので、改行コードがLFになっているのでしょう。
nkf とかのツールを使って変換してから処理すればどうですか

nkf -SsLwO original.txt convert.txt

QMicrosoftマイクロソフトのエクセルでマクロVBAをやりたいです。 プログラムがちょっとわかり

MicrosoftマイクロソフトのエクセルでマクロVBAをやりたいです。 プログラムがちょっとわかりません。

sheet1、sheet2、sheet3を参照します。各sheetの中は写真のようなデータが入ってます。
sheet1から始めます。
列Aの3行から23行までをみます。
◯が書いてあったら、その行をsheet4に貼り付けます。
順次、23行まで繰り返します。
次のsheet2も同じ事を繰り返します。
次のsheet3も同じ事を繰り返します。
sheet4に◯が書かれた行の一覧が出来れば成功です。
可能でしょうか?
出来れば、モジュールmoduleに貼り付けるだけで終わるようにプログラム教えてもらえますか?

Aベストアンサー

このサイトは先行するブランクは詰められてしまう為、_を使います。
_の部分は半角スペースに置き換えてください。


Sub WK()

Dim Cnt1 As Long
Dim Cnt2 As Long
Dim PNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh2 = Worksheets("sheet4")

PNT=0

For Cnt2 = 1 To 3
_If Cnt2=1 Then
__Set Sh1 = Worksheets("sheet1")
_ElseIf Cnt2 = 2 Then
__Set Sh1 = Worksheets("sheet2")
_Else
__Set Sh1 = Worksheets("sheet3")
_EndIf

_END1 = Sh1.Range("D65536").End(xlUp).Row'全体行数取得


__For Cnt1=3 To END1
___If Sh1.Range("A"&Cnt1).Value= "○" Then
____PNT=PNT+1
____Sh2.Range("A"&PNT).Value = Sh1.Range("A"&Cnt1).Value
____Sh2.Range("B"&PNT).Value = Sh1.Range("B"&Cnt1).Value
____Sh2.Range("C"&PNT).Value = Sh1.Range("C"&Cnt1).Value
____Sh2.Range("D"&PNT).Value = Sh1.Range("D"&Cnt1).Value
____Sh2.Range("E"&PNT).Value = Sh1.Range("E"&Cnt1).Value
____Sh2.Range("F"&PNT).Value = Sh1.Range("F"&Cnt1).Value
___EndIf

__Next Cnt1
Next Cnt2


Application.StatusBar = False
End Sub

このサイトは先行するブランクは詰められてしまう為、_を使います。
_の部分は半角スペースに置き換えてください。


Sub WK()

Dim Cnt1 As Long
Dim Cnt2 As Long
Dim PNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh2 = Worksheets("sheet4")

PNT=0

For Cnt2 = 1 To 3
_If Cnt2=1 Then
__Set Sh1 = Worksheets("sheet1")
_ElseIf Cnt2 = 2 Then
__Set Sh1 = Worksheets("sheet2")
_Else
__Set Sh1 = Worksheets("sheet3")
_EndIf

_END1 = Sh1.Range("D65536").End(xlUp)....続きを読む

Qエクセル マクロでのエクセルファイル取込について

エクセルで別のエクセルファイルをマクロで取込み、取込したデータを自動で任意の場所にデータが入力されるようなものを作りたいと考えています。
csvデータの取込は作ることが出来たのですが、エクセルファイルをcsvデータのように取込することは出来ないでしょうか?
出来ないとしたら、取込したいエクセルファイルを一度csvで保存してからcsvとして取込するというやり方で対応するしかないでしょうか?
出来れば、取込したいエクセルファイルのシートが複数にわかれていて、全シートの情報を取込したいと考えているので、エクセルのままで全シート取り込めれば・・と思います。

何か上記の方法でなくとも、最善の方法(一番工数が少なく済む方法)があれば教えていただきたいです。
よろしくお願いします。

Aベストアンサー

こんばんは。

エクセルファイルを開いておけばいいだけだと思うのですが・・・?

セルのデータは、開いていればブック名からきちんと指定してやれば取得できます。

a = Workbooks("book1.xlsx").Worksheets("sheet1").Range("A1").Value

の様な感じ。

開くのもマクロで。


このカテゴリの人気Q&Aランキング

おすすめ情報