痔になりやすい生活習慣とは?

VisualBasic2005ExpressEditionで「ボタンを押すとピクチャーボックスに画像をランダムで表示」させたいんですが、どうやるかわかりません教えてください。何件か探しては見たんですが見つかりませんでした。もしかしてVBでは、そういったプログラムはできないんでしょうか?

A 回答 (2件)

えっと、やり方は他にもあると思いますが、楽なやつで。



まず、それぞれの画像ファイルの名前を格納する配列を用意します。
Dim strPicture(10) As String
strPicture(0) = "pic1.jpg"
strPicture(1) = "pic2.jpg"
strPicture(2) = "pic3.jpg"



という風にやります。配列の数は表示させたい画像分だけ作ります。

次に、ランダムに表示させるということなので
乱数を発生させる必要がありますね。

' 0 以上 a 未満の乱数を取得する
Dim intResult As Integer = hRandom.Next(a)

とやります。 aはランダムに表示させたい画像の最大枚数-1ですね。
すると、intResultに、ランダムな数値が入ります。

そうしたら

PictureBox1.image = Image.FromFile(strPicture(intResult))

とします。

上記のコードを、ボタンをクリックしたときのイベントに追加すれば
OKです。

ただ、上記のように画像ファイル名のみだと
プログラムがあるフォルダ内に画像ファイルがないと読み込めないので
フルパスで書いた方がいいかもです。

strPicture(0) ="C:\~" という具合です。
    • good
    • 2

先ほどの者ですが、一つ書き忘れ


乱数を発生させるときの、インスタンス生成を忘れておりました。
hRandom.nextの前に↓のコードを追加してください。

Dim hRandom As New System.Random()
    • good
    • 1
この回答へのお礼

無事にできました。
親切に教えてくださり、ありがとうございます。

お礼日時:2008/01/14 16:39

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

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

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

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

QVBAで画像を表示する方法

VBA初心者です。ExcelのVBAでプログラミングの練習をしています。
早速ですが質問させてください。
ユーザーフォーム上にコマンドボタンをクリックすることにより画像を表示させることはできるのですが、これをユーザーフォームを開いた瞬間に自動的に表示させる方法はないのでしょうか?

ちなみに現在は以下のようにしています。
Private Sub CommandButton1_Click()
Image1.Picture = LoadPicture(" ")
End Sub

インターネットで調べてみても見つからないので質問させてもらいました。分かりにくい説明でしたらすみません。

Aベストアンサー

UserFormのinitializeイベントかActivateイベントを使ってください。

Private Sub UserForm_Initialize()
 Image1.Picture = LoadPicture("C:\aaa.jpg")
End Sub

または、

Private Sub UserForm_Activate()
 Image1.Picture = LoadPicture("c:\aaa.jpg")
End Sub

Q画像をランダムに表示させたい(VB6.0)

A、B、C、D、E、Fの6枚の画像を用意して
ボタンを押すごとにA、B、Cの3枚の画像をランダムに表示させる方法を教えて下さい。

また、
Aが表示されたとき、キーボードの「A」を押すとDを表示
Bが表示されたとき、キーボードの「B」を押すとEを表示
Cが表示されたとき、キーボードの「C」を押すとFを表示
としたいのですが・・・。

どなたかご教授お願いします。

Aベストアンサー

#1です。訂正版です。
前準備として、
 1.フォーム上にピクチャーボックス(Picture1)、コマンドボタン(Command1)を配置。
 2.フォームのKeyPreviewプロパティをTrueにする。(KeyPressイベントを他のコントロールより先に受け取るため。)
次にフォームモジュールに以下のように記述することでできました。

Dim strABC As String '(フォーム)モジュールレベルの変数

Private Sub Command1_Click()
  Dim intRND As Integer

  Randomize '乱数発生ルーチンを初期化

  intRND = Int(3 * Rnd + 1) '1~3の間で乱数を発生

  'intRND(1~3の整数)の値からA,B,Cの画像を表示。strABCにどの画像を表示したか設定。
  Select Case intRND
    Case 1
      Picture1.Picture = LoadPicture("C:\A.BMP")
      strABC = "A"
    Case 2
      Picture1.Picture = LoadPicture("C:\B.BMP")
      strABC = "B"
    Case 3
      Picture1.Picture = LoadPicture("C:\C.BMP")
      strABC = "C"
  End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
  If UCase(Chr(KeyAscii)) = "A" And strABC = "A" Then
    Picture1.Picture = LoadPicture("C:\D.BMP")
  ElseIf UCase(Chr(KeyAscii)) = "B" And strABC = "B" Then
    Picture1.Picture = LoadPicture("C:\E.BMP")
  ElseIf UCase(Chr(KeyAscii)) = "C" And strABC = "C" Then
    Picture1.Picture = LoadPicture("C:\F.BMP")
  End If
End Sub

#1です。訂正版です。
前準備として、
 1.フォーム上にピクチャーボックス(Picture1)、コマンドボタン(Command1)を配置。
 2.フォームのKeyPreviewプロパティをTrueにする。(KeyPressイベントを他のコントロールより先に受け取るため。)
次にフォームモジュールに以下のように記述することでできました。

Dim strABC As String '(フォーム)モジュールレベルの変数

Private Sub Command1_Click()
  Dim intRND As Integer

  Randomize '乱数発生ルーチンを初期化

  intRND ...続きを読む

QExcelで事前にセルに入力した言葉をランダムに表示

例えばA1に「いぬ」 A2に「ねこ」 A3に「ぞう」 A4に「たぬき」 A5に「きつね」と入力します
次に
B1~B10に 「いぬ」「ねこ」「ぞう」「たぬき」「きつね」のいずれかを自動にランダムに表示する方法を教えてください
こんな便利な機能があれば良いと思うのですが・・・

Aベストアンサー

=INDIRECT("A"&INT(RAND()/0.2)+1)

INT(RAND()/0.2)+1 で1~5までの整数が得られます。
INT(RAND()/0.1)+1 で1~10までの整数が得られます。
INT(RAND()/0.02)+1 で1~50までの整数が得られます。
INT(RAND()/0.01)+1 で1~100までの整数が得られます。

それでA1からA5、A1からA10、A1~A50、A1~A100のセルの内容を取得しています。A2からなら+2にしてください。
F9キーを押すたびに再計算されて、表示も変わります。

QVBで作った乱数を一度も重複させずに表示する方法を教えてください!

VB2005で乱数を作り、ボタンを押すごとに一つづつその数字がひょうじされるようにしたいのですが、その数字が一度も重複されないようにするにはどうしたらいいのでしょうか?
例えばボタンを百回押すと、1から100までの数字がランダムに、一度も重複されずに表示されるようにするにはどのようなコードを書けばよいのでしょうか?

Aベストアンサー

>もう一度同じ作業を行った際に、
Form1_LoadにRandomize()を追加します。
Rnd関数の乱数ジェネレータに新しいシード値を指定して初期化。

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim i As Integer
For i = 1 To 100
tbl.Add(i)
Next
Randomize()
End Sub

QVB カウントダウンタイマーの作り方

1か月前からVBの勉強を始めたものです。

下記のように、カウントダウンタイマーを作成したいですが
やり方がわからないです。

1 From構成:
  textBox1(時刻指定用),label1(カウントダウン表示用)、Button1(スタート用)

2 使用:
  textBox1に "**:**"形で指定したい時間と分を入力して、Button1を押したら、label1内に今の時刻からのカウントダウンタイマーを表示される

3 カウントダウンが0になったら、何とかの形で知らせてくれる。
 msgboxでもかまいません。

ネットでも調べましたが、自分のニーズに合わせるものを見つかりませんでした。~@~

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

Aベストアンサー

Dim dTime As DateTime

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
dTime = TextBox1.Text
Timer1.Interval = 1000
Timer1.Enabled = True

End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

dTime = dTime.AddSeconds(-1)

TextBox2.Text = dTime

If dTime = "0:0:0" Then
Timer1.Enabled = False
MessageBox.Show("終了")

End If

End Sub


こんなんでどうでしょうか?

Dim dTime As DateTime

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
dTime = TextBox1.Text
Timer1.Interval = 1000
Timer1.Enabled = True

End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

dTime = dTime.AddSeconds(-1)

TextBox2.Text = dTime

If dTime = "0:0:0" Then
...続きを読む

Qエクセル指定した範囲からランダムで一つ抽出

エクセルの関数についての質問なのですが、

B1~B5に値がならんでいたとして、B1~B5の中からランダムに一つ抽出したものをA3に表示する関数はありますか?

Aベストアンサー

A3に次の式を入力すればよいでしょう。

=INDEX(B1:B5,RANDBETWEEN(1,5))

QSub ***( ) と Private Sub ***( ) の違い

初歩的な質問で申し訳ありませんが・・・

自分でコードを書いていても、イベントが発生したりした時の処理で、コードのウィンドウで上のドロップダウンリストで選択できる時の処理などは自動的に[Private Sub Command1_Click( )]などと出てくるのでそのまま使っています。自分で別途プロシージャーを作成する時は[Sub ****( )]としています。
ですがその違いを理解しないまま、自分で作成する時は[Private Sub]ではなくて[Sub]を使っています。

Sub ***( ) と Private Sub ***( ) の違いは何なんでしょうか?
どなたか説明頂けませんか?
よろしくお願いします。

Aベストアンサー

「Sub」の部分にカーソルを置いて[F1]を押せばヘルプが起動します。
「指定項目」のところに「Public」と「Private」の説明がありますよ。
省略して「Sub hogehoge()」とした場合は「Public」とみなされます。

Publicは「すべてのモジュールから呼び出せるプロシージャ」ということになります。
Privateとすると「同じモジュールの中からしか呼び出せないプロシージャ」となります。

もしExcelをお持ちでしたらExcelのVBEで標準モジュールを追加し、「Sub Test1()」と「Private Sub Test2()」を作成してみてください。
そしてExcelの[ツール]-[マクロ]-[マクロ(Alt+F8)]でマクロ実行のダイアログを表示させてみるとわかります。
ここには実行できるプロシージャの一覧が表示されますが、Test1は表示されているけれどTest2は表示されません。
Test1はPublicで、Test2はPrivateだからです。

QExcel VBA じゃんけん

じゃんけんのプログラミングを作っているのですが、今できているじゃんけんの
プログラムの追加機能として得点式のゲームにしたいと思っています。
ルールとしては、10回じゃんけんをしてポイントを0から
勝ったら 得点+1
引き分けたら 得点 +0
負けたら 得点 -1
というふうにして
最終的に合計点数が0より大きければ勝ち0より小さければ負け
というようなものにしたのですが
どうすればよいですか?
ついでに完成したじゃんけんプログラムは下のような感じです。





Private Sub CommandButton1_Click()

Cells(1, 1) = Int(Rnd * 3)

If Cells(1, 1) = 0 Then
Label1.Caption = "私もグー。だから引き分けです。"
End If

If Cells(1, 1) = 1 Then
Label1.Caption = "私はチョキ。だからあなたの勝ちです。"
End If

If Cells(1, 1) = 2 Then
Label1.Caption = "私はパー。だからあなたの負けです。"
End If

End Sub

じゃんけんのプログラミングを作っているのですが、今できているじゃんけんの
プログラムの追加機能として得点式のゲームにしたいと思っています。
ルールとしては、10回じゃんけんをしてポイントを0から
勝ったら 得点+1
引き分けたら 得点 +0
負けたら 得点 -1
というふうにして
最終的に合計点数が0より大きければ勝ち0より小さければ負け
というようなものにしたのですが
どうすればよいですか?
ついでに完成したじゃんけんプログラムは下のような感じです。





Private S...続きを読む

Aベストアンサー

お疲れさまです

入力がないので、こちらが出すのはグーときめているのでしょうか?

一応、10回勝負を考えてみました。

Private Sub CommandButton1_Click()

Dim i As Integer
Dim ft As Integer

ft = 0



For i = 1 To 10

MsgBox i & "回目"
Cells(1, 1) = Int(Rnd * 3)

If Cells(1, 1) = 0 Then
Label1.Caption = "私もグー。だから引き分けです。"
ft = ft
End If

If Cells(1, 1) = 1 Then
Label1.Caption = "私はチョキ。だからあなたの勝ちです。"
ft = ft + 1
End If

If Cells(1, 1) = 2 Then
Label1.Caption = "私はパー。だからあなたの負けです。"
ft = ft - 1
End If

Next i

If ft > 0 Then
Label1.Caption = "10回勝負結果=あなたの勝ちです"
Else
Label1.Caption = "10回勝負結果=あなたの負けです"
End If

End Sub

お疲れさまです

入力がないので、こちらが出すのはグーときめているのでしょうか?

一応、10回勝負を考えてみました。

Private Sub CommandButton1_Click()

Dim i As Integer
Dim ft As Integer

ft = 0



For i = 1 To 10

MsgBox i & "回目"
Cells(1, 1) = Int(Rnd * 3)

If Cells(1, 1) = 0 Then
Label1.Caption = "私もグー。だから引き分けです。"
ft = ft
End If

If Cells(1, 1) = 1 Then
Label1.Caption = "私はチョキ。だからあなたの勝ちです。"
ft = ft + 1
End If

If ...続きを読む

Q任意フォルダから画像をすべてエクセルの指定マスに貼り付けをしたい

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるようにしようとすると、かなり難易度が高くお手上げ状態です。
このプログラムをどのように改修すれば可能になるかお教えください。

Sub 図11()

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)

' 貼り付け開始セルを選択
Range("B6").Select

' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
For i = LBound(Filenames) To UBound(Filenames)
Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の高さをアクティブセルにあわせる
' 結合セルの場合でも対応
.Height = ActiveCell.MergeArea.Height
End With

' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
ActiveCell.Offset(5).Select

Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True

End Sub

よろしくおねがいします。
※マクロはほぼ初心者です。大体がネットからコピペをして使っている程度のレベルです。

ネットでいろいろ検索し、試してみましたが自分の思うような仕上がりにならず困っています。

実施したい内容としては、マクロで
①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
②マクロを開始するとフォルダを選ぶ画面が現れる
③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
④画像は、セルの大きさに合わせて自動調整される
というものです。

1枚ずつを選んでセルに自動調整で貼り付けるということは真似事でできましたが、希望の内容をできるよう...続きを読む

Aベストアンサー

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトしてください。また、DoEvents も入れておきました。
④は、何も手を付けていません。
コメント・アウトした部分で不要なら削除してください。

'//
Sub 図11R()
 'No. 9024507
 Dim strFilter As String
 Dim Filenames() As Variant
 Dim fName As Variant, ext As String
 Dim PIC As Picture
 Dim k As Long, m As Long
 Dim i As Long, j As Long
 Dim cnt As Long
 Dim FirstRng As Range
 Dim r As Range
 Dim Sel_Folder As Object, Sel_Path As String
 cnt = 0 'カウントの初期値
 '貼り付け最初のセル
 Set FirstRng = Range("A2")
 
  Set Sel_Folder = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "フォルダを選択してください", 5)

  If Not Sel_Folder Is Nothing Then
    Sel_Path = Sel_Folder.Self.Path
  Else
   Exit Sub
  End If
 
 ' 「ファイルを開く」ダイアログでファイル名を取得
 ChDir Sel_Path
' strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
' Filenames = Application.GetOpenFilename( _
' FileFilter:=strFilter, _
' Title:="図の挿入(複数選択可)", _
' MultiSelect:=True)
 fName = Dir("*.*", vbNormal)
 Do While fName <> ""
  If fName <> "." And fName <> ".." Then
   ext = Mid(fName, InStrRev(fName, ".") + 1)
   If InStr(1, "jpg,jpeg,gif,bmp,png", ext, 1) > 0 And Not fName Like "#*" Then
    cnt = cnt + 1
    DoEvents
    ReDim Preserve Filenames(1 To cnt)
    Filenames(cnt) = fName
    ''安全のため(上限を設定)
    If cnt > 100 Then Exit Do
   End If
  End If
  fName = Dir()
 Loop
 If cnt = 0 Then Exit Sub
 
 ' ファイル名をソート
 Call BubbleSort_Str(Filenames, True, vbTextCompare)
 
 '' 貼り付け開始セルを選択
 'Range("B6").Select
 
 ' マクロ実行中の画面描写を停止
 Application.ScreenUpdating = False
 ' 順番に画像を挿入
 k = LBound(Filenames)
 m = UBound(Filenames)
 
 For j = 1 To Int(m / 4) + Abs(m Mod 4 > 0)
  For i = 1 To 4
   Set PIC = ActiveSheet.Pictures.Insert(Filenames(k))
   Set r = FirstRng.Cells(1 + (j - 1) * 2, i)
   
   '-------------------------------------------------------------
   ' 画像の各種プロパティ変更
   '-------------------------------------------------------------
   With PIC
    .Top = r.Top ' 位置:アクティブセルの上側に重ねる
    .Left = r.Left ' 位置:アクティブセルの左側に重ねる
    .Placement = xlMove ' 移動するがサイズ変更しない
    .PrintObject = True ' 印刷する
   End With
   With PIC.ShapeRange
    .LockAspectRatio = msoTrue ' 縦横比維持
    ' 画像の高さをアクティブセルにあわせる
    ' 結合セルの場合でも対応
    .Height = r.MergeArea.Height
   End With
   
   ' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]
   ' ActiveCell.Offset(5).Select
   
   Set PIC = Nothing
   k = k + 1
   If k >= m Then Exit For
  Next i
 Next j
 Application.ScreenUpdating = True
 ChDir ThisWorkbook.Path
End Sub

>①エクセルシートのA2,B2,C2,D2,A4,B4,C4,D4 …A24,B24,C24,D24セルに画像を挿入
>②マクロを開始するとフォルダを選ぶ画面が現れる
>③フォルダを選択すると、①にフォルダ内の画像がすべて貼り付けられる
>④画像は、セルの大きさに合わせて自動調整される

①は、A2で始まり、横に4進み、下に2進むという数列を設けています。
②は、ご存知のShell のBrowseForFolderを利用しましたが、他にもあるでしょう。
問題は③かな。一応、 ''安全のため(上限を設定) という箇所を設けましたが、不要なら、コメント・アウトし...続きを読む

Q回数のカウント

コマンドボタンを押すたびに何回押したか分かるような
プログラミングを教えて頂きたいのですが。
よろしくお願いします。

Aベストアンサー

こんにちは。maruru01です。

横から失礼しますが。

>私の案では出てこない発想をお持ちの方はたくさんいるはず

でしたら、その案(コード)を書かれてはいかがですか。
(もちろん間違っていても、一向に構いません。)
そうすれば、そのコードに対する指摘という形で回答し易いですし、siamzouさんの勉強にもなると思います。
また、siamzouさんと同じ案の人が回答する無駄はなくなりますし。

あと、余計なことかも知れませんが、プログラミングの質問というのは、単に正解を知るだけではなく、その正解にいたる道筋や考え方、基本的なコーディングなどを学び、それを今後に生かすことが大切で、その方が質問者のためになる、という回答者もいます。
そういう人たちは、あえて具体的なコードを書かずにヒントで留めているのです。
そういう回答者の気持ちを、少しでもいいから理解してあげて下さい。

あと、質問内容やコードなどからある程度質問者のレベルはわかるので、レベルに合わせた回答をしてくれる回答者も多いです。
かえって、「初心者です。」と自分から言うのは敬遠されることが多いと思いますよ。

質問の回答ですが、テキストボックスのChangeイベントだと、1文字削除したり、付け加えただけで起こってしまうので、LostFocusやExitイベントがいいと思います。
テキストボックスの内容を保存する変数を用意しておき、これらのイベントで新しい内容を変数に格納します。
この時、格納前に元の変数の内容と比較して、異なっていたら、カウンタをリセットします。
カウンタ部分のプログラミングが分かったのなら、きっとご自分で出来ると思いますよ。

こんにちは。maruru01です。

横から失礼しますが。

>私の案では出てこない発想をお持ちの方はたくさんいるはず

でしたら、その案(コード)を書かれてはいかがですか。
(もちろん間違っていても、一向に構いません。)
そうすれば、そのコードに対する指摘という形で回答し易いですし、siamzouさんの勉強にもなると思います。
また、siamzouさんと同じ案の人が回答する無駄はなくなりますし。

あと、余計なことかも知れませんが、プログラミングの質問というのは、単に正解を知るだけではなく、...続きを読む


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

人気Q&Aランキング