投稿日	： 2007/06/06(Wed) 13:58
投稿者	： なべ
Ｅメール	：
ＵＲＬ	：
タイトル	： 画像の自動読み込み

タイトルのとおりです
1つのフォルダ内の複数のナンバリングされた画像ファイルを順に自動的に開いてほしいのですが、どうにも行き詰ってしまいました。
VBはまだ初心者で、触り始めてからまだ1ヶ月ほどです。
下に組んだプログラムを載せておくので、指摘のほどお願いします。


Option Explicit

===========================================================
Private Sub Command1_Click()

'ココで画像フォルダを記憶させる

On Error GoTo Err_Command1_Click

Pic1.Cls

CommonDialog1.Filter = "*.bmp|*.bmp"
CommonDialog1.ShowOpen

Pic1.Picture = LoadPicture(CommonDialog1.FileName)

Text2.Text = Pic1.Width / Screen.TwipsPerPixelX - 4
Text1.Text = Pic1.Height / Screen.TwipsPerPixelY - 4

Exit_Command1_Click:
Exit Sub

Err_Command1_Click:
MsgBox ("ファイルを開く作業をキャンセルします")

Exit Sub
End Sub

=========================================================
Private Sub Command2_Click()
Unload Me

End Sub
=========================================================

Private Sub Command3_Click()

'==========関数の宣言==============
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim k As Integer
Dim col1 As Long
Dim col2 As Long
Dim sum1 As Long
Dim l As Integer
'==================================


'=================Excel開く宣言================
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

xlApp.Visible = True
xlSheet.Activate
'==============================================

l = 0
'Excelの列担当繰り返し構文,画像ファイル分繰り返す
For l = 1 To Text3.Text

'１行目にナンバリングする
xlSheet.Cells(1, l).Value = l
   i = 0


'↓ココから画像を開くまでを自動化したい
'================画像を開く==================
Pic1.Cls

CommonDialog1.Filter = "*.bmp|*.bmp"
CommonDialog1.ShowOpen

Pic1.Picture = LoadPicture(CommonDialog1.FileName)

Text2.Text = Pic1.Width / Screen.TwipsPerPixelX - 4
Text1.Text = Pic1.Height / Screen.TwipsPerPixelY - 4
'=============================================

'=======以下PopImagingの作業"垂直投影"を再現=======
    For i = 0 To Text2.Text - 1

       sum1 = 0
       j = 0

       For j = 0 To Text1.Text - 1
          col1 = Pic1.Point(i, j)
          col2 = 0

          For k = 0 To 256
             If col1 = RGB(k, k, k) Then
                col2 = k
             End If
          Next k
  
       sum1 = sum1 + col2
       Next j

       sum1 = sum1 / Text1.Text
       '2行目からデータを入力
       xlSheet.Cells(i + 2, l).Value = sum1
    
    Next i
'=================================================

Dim Lngst As Long
Lngst = Timer
Do While Timer - Lngst < 1
DoEvents
Loop

Next l

'============Excel閉じる================
xlApp.DisplayAlerts = False
xlSheet.SaveAs "C:\Documents and Settings\a1417393\デスクトップ\test1.csv", xlCSV
xlApp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
'========================================

End Sub

★ - 画像の自動読み込み - なべ 07/06/06-13:58No.9307
• Re: 画像の自動読み込み - 琴 07/06/07-19:30 No.9314
  • Re^2: 画像の自動読み込み - なべ 07/06/11-12:42 No.9328
    • Re^3: 画像の自動読み込み - るしぇ 07/06/11-13:11 No.9329
      • Re^4: 画像の自動読み込み - なべ 07/06/11-15:30 No.9332
        • Re^5: 画像の自動読み込み - るしぇ 07/06/11-18:38 No.9333
          • Re^6: 画像の自動読み込み - なべ 07/06/11-21:23 No.9334