NC指示書用EXCELマクロ 続き その3

前回は、画像ファイルを選択する段階でソートしないと、ちゃんとした順番にならない場合があるとわかったところで終わってしまいました。ソートするにも自前か、セルに代入するかになったのですが、新しいセルにデータを入れるのもなにげに面倒くさそうだし、データも10数個だから時間もかからないだろうという事で、自前で行く事にしました。
その手の解説本やネットで探した方が速いとも思いましたが、また面倒という思いが出て、それにこれくらい出来なくてどうするとも思ったので、自前で考えてみました。
知らないコマンドは調べないとまず永久に使い方はわかりませんが、これは算数の延長だろうという事です。
考えたのは、
名前は6桁のシーケンシャルなので、同じ番号はない。という事は大きいか小さい。また総数は把握しているので何番目かわかればいい。拡張子は基本的にbmpと決めてはいるものの、jpgにする可能性も否定できない(bmpとjpgが混じるのも考慮する)為、拡張子もとっておく。
という事くらいです。
そうすると比較すればいいという事になりますが、しばらく考えて割と単純だという事に気がつきました。最初のデータを全部(面倒くさいので自分とも)と比較して、小さいのがいくつあるかという事です。

例えば、小さいのが2つあれば自分はちびから3番目になります。

そうすれば、後はシーケンス部をどう取り出すかだけです。選択された画像ファイルはフルパスなのでそのままでは使えません。そこでRight、Left関数で取り出すことにしました。
ファイル名は、

WinShotのパス¥WS000000.bmp

ですから、右から10文字がシーケンスと拡張子です。そしてその中の左から6文字がシーケンス部、右側3文字が拡張子です。おまけにFileDialogを出す時にパス部はWinShotPathとしていますから、これで全てOKです。
作ったのが以下になります。

'選択ファイルからファイル名のシーケンシャル部を取り出す
    For i = 1 To .SelectedItems.Count
       InputFileName(i) = Right(.SelectedItems(i), 10)
       InputFileNum(i) = Left(InputFileName(i), 6)
    Next i

'番号順にソート(比較元より小さいのが見つかったら、その数を数える)
    For i = 1 To .SelectedItems.Count
       For j = 1 To .SelectedItems.Count
          If InputFileNum(i) > InputFileNum(j) Then
             k = k + 1
          End If
       Next j
       WinShotFileName(k) = WinShotPath & "\WS" & InputFileName(i)
       k = 1
    Next i

どうでしょう。拡張子は使いませんでした。本当は.SelectedItems(i)をそのままWinShotFileName(k)に入れてもいいのでしょうが、こうしてます。意味はありません。
これでソートは出来ましたから、後はファイルの挿入です。

挿入にはPictures.Insertが使える事は調べました。EXCELのVBAヘルプではわからなかったので、ネットで調べました。

Activesheet.Pictures.Insert(Filename:=画像ファイルのフルパス名)

でいい様です。実際には挿入よりもその後の体裁づくりの方が面倒でした。画像ファイルが大きすぎて、複数ページになったり、上下左右の余白、画像枠の設定等です。
これらは、ひとつひとつ調べるのがそれこそ面倒なので、マクロ記録を使って実際に手作業でやって、後で記録を見た方が速いです。
今回もそうしました。
以下が最終的に画像ファイル挿入用として作成したマクロです。シートが追加されたり、マージン変更したりすると、時間もかかるし、見苦しいので、マクロが終了するまで、表示を更新しない様にしています。コメントを見ていただければ、内容はわかると思います。

Sub NC絵追加()
'
' 指示書ブックに工具軌跡図を追加する
'

   Dim SelResult As Integer
   Dim WinShotPath As String
   Dim WinShotFileName(100) As String
   Dim InputFileName(100) As String
   Dim InputFileExt(100) As String
   Dim InputFileNum(100) As Long
   Dim InputFileChr(100) As String
   Dim NCSheetNum As Integer
   Dim i, j, k As Integer

'マクロ終了まで画面更新を停止
   Application.ScreenUpdating = False

'変数初期設定
   WinShotPath = "C:\Documents and Settings\ck07\My Documents\My Pictures\WinShot"
   NCSheetNum = 1
   k = 1

'画像ファイルの複数選択
   With Application.FileDialog(msoFileDialogFilePicker)
      .InitialFileName = WinShotPath
      .Title = "工具軌跡図選択"
      .Filters.Clear
      .Filters.Add "画像ファイル", "*.bmp;*.jpg"
      .AllowMultiSelect = True
      SelResult = .Show
      If SelResult = 0 Then
         Exit Sub
      End If

'選択ファイルからファイル名のシーケンシャル部を取り出す
      For i = 1 To .SelectedItems.Count
         InputFileName(i) = Right(.SelectedItems(i), 10)
         InputFileNum(i) = Left(InputFileName(i), 6)
      Next i

'番号順にソート(比較元より小さいのが見つかったら、その数を数える)
      For i = 1 To .SelectedItems.Count
         For j = 1 To .SelectedItems.Count
            If InputFileNum(i) > InputFileNum(j) Then
               k = k + 1
            End If
         Next j
         WinShotFileName(k) = WinShotPath & "\WS" & InputFileName(i)
         k = 1
      Next i

'選択した画像ファイルを貼り付けたシートを挿入
      For i = 1 To .SelectedItems.Count
         With Worksheets.Add(after:=Worksheets(Worksheets.Count))
            .Name = "NC絵" & NCSheetNum
         End With
         NCSheetNum = NCSheetNum + 1
         With ActiveSheet.Pictures.Insert(Filename:=WinShotFileName(i))
            .Top = ActiveCell.Top  '画像を左上に挿入
            .Left = ActiveCell.Left
'画像ファイルが大きい場合に縮小する
            If .Width > 900 Then
               .Width = 800
            End If
            If .Height > 525 Then
               .Height = 525
            End If

         End With
'画像の枠線の太さを0.5ポイントにする
         With ActiveSheet.Pictures.ShapeRange.Line
            .Weight = 0.5
         End With
'追加するシートのページ設定(用紙サイズ、向き、マージン、中央配置)
         With ActiveSheet.PageSetup
            .PaperSize = xlPaperA4
            .Orientation = xlLandscape
            .LeftMargin = Application.InchesToPoints(0.511811023622047)
            .RightMargin = Application.InchesToPoints(0.511811023622047)
            .TopMargin = Application.InchesToPoints(1.04803149606299)
            .BottomMargin = Application.InchesToPoints(0.393700787401575)
            .CenterHorizontally = True
         End With
      Next i
   End With

End Sub



関連記事

広告




[ 2012/04/28 20:19 ] ソフト関係 | TB(0) | CM(0)

コメントの投稿













管理者にだけ表示を許可する

トラックバック

この記事のトラックバックURL