[[20050728114957]] 『テキストボックスのすぐ下のセル』(ブク) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『テキストボックスのすぐ下のセル』(ブク)
 いつもお世話になります。
 現在商品管理で悪戦苦闘しておりまして、
[[20050308143658]]『画像のファイル名の取得』(55歳の初心者)と
[[20040929082726]]『写真台帳作成』(nao)を参考に、
  画像はテキストボックスに、ファイル名はそのすぐ下のセルに取得したいのですが、
 “テキストボックスのすぐ下のセル”を判別させる方法がわかりません。

  具体的に何がしたいのかというと…
 ・画像の大きさを統一して配置
 ・画像のファイル名を画像のすぐ下に表示
 ・レイアウトはこんな感じで 
    _________      _________      _________      _________  
  |       |    |       |    |       |    |       |  
    | 画像  |      | 画像  |      | 画像  |      | 画像  |  
    |       |      |       |      |       |      |       |   
  ---------    ---------    ---------    ---------  
  ファイル名    ファイル名    ファイル名    ファイル名  
   空白セル     空白セル     空白セル     空白セル    
   空白セル     空白セル     空白セル     空白セル    

  これがA4縦に5個です。
  (テキストボックスは1つのセルに納まるように行の高さを調整してあります。)
  “テキストボックスのすぐ下の列”を指定できるならレイアウトはあまり関係ないでしょうか。

  できれば、そのコードをどこに入れればよいのかも教えていただけると大変助かります。
  よろしくお願いします。  winXP Excel2000です。
  

 こんにちは。
 取りあえず1個だけの場合ですが・・・。
 ループは適当に組んでください。

 ファイルパス = "C:\Documents and Settings\新フォルダ\藤原.bmp"
 With Range("A4")
      ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
            .Left, .Top, .Width, .Height).Select
      Selection.ShapeRange.Fill.UserPicture ファイルパス
      .Offset(1).Select
      .Offset(1).Value = Dir(ファイルパス)
 End With
 BJ


  BJ様、回答ありがとうございます。 返事が遅くなって申し訳ありません。 

  上記のマクロを試してみたのですが、セルの大きさに合わせてテキストボックスが
 作成されるというところに感動しました。 そんなことも出来るんですね…!
  現在、色々試行錯誤しておりまして、わからないながら適当に組み合わせてみまし
 たところ(当然?)エラーになりました。

 Sub Sampel()
 Dim myFile As String

    myFile = Application.GetOpenFilename("画像 ファイル (*.jpg;*.bmp), *.jpg;*.bmp")
    If myFile = "False" Then Exit Sub

 With Range(ActiveCell)
      .ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
            .Left, .Top, .Width, .Height).Select
      Selection.ShapeRange.Fill.UserPicture ("画像ファイル,*.jpg;*.bmp")
      .Offset(1).Select
      .Offset(1).Value = Dir("画像ファイル,*.jpg;*.bmp")
 End With

 End Sub

  With Range(ActiveCell)のところで
     実行時エラー'1004'
     アプリケーション定義またはオブジクト定義のエラーです
 となってしまいます。 

  どこをどのように直せばよいか教えていただけますでしょうか。

  (ブク) 


 >  With Range(ActiveCell)のところで
 >     実行時エラー'1004'
 >     アプリケーション定義またはオブジクト定義のエラーです

 >   With Range(ActiveCell)
 >      .ActiveSheet.Shapes.AddTextbox(msoTextOrienta
   上のコードの意味
   Range(ActiveCell)自体間違ってますが、
   (Rengeプロパティにアクティブセルを指定している、ヘルプを良く見てください。)
   With ActiveCell だとして
   アクティブセルのアクティブシート???の図形オブジェクト・・・・。

 すでにテキストが作ってあるなら、消されない限り同じ名前のはずだから、
 こんな感じで良いです。

 ActiveSheet.Shapes("Text Box 1").Select
 Selection.ShapeRange.Fill.UserPicture ファイルパス

 また、セルにファイル名を書きたいとの事でしたが、すでにテキストが作られているセルの
 位置が解っているはずですから、書き込むセルも初めから解っているはずです。 

 お邪魔します。 ひょっとして場所がわからないのではないでしょうか?
このコードがヒントになれば幸いです。勘違いでしたら、お許しをm(__)m
 >そのすぐ下のセルに取得したいのですが、
なのでちょっと追加です。
Option Explicit
Sub てすと()
Dim i As Long
With Sheets("Sheet1")
    For i = 1 To .Shapes.Count
        With .Shapes(i)
            If .Type = msoTextBox Then
                MsgBox "名前は " & .Name & vbCrLf & _
                        "左上端セルは " & .TopLeftCell.Address & " です" & vbCrLf & _
                        "右下端セルは " & .BottomRightCell.Address & " です"
            End If
        End With
    Next
End With
End Sub
(SoulMan)


  無記名様、SoulMan様、回答ありがとうございます。
  返事がとっても遅くなって申し訳ありません。

  別の仕事のほうで忙しくなってしまい、暇をみつけてはチョコチョコと
 教えていただいたものを確認しているのですが、素人が片手間でやっているので
 ちっとも進んでない状況であります…(ToT)。

  言い訳が長くなってしまいましたが、皆様に教えて頂いたコードを元に
 ぐちゃぐちゃいじってみたのですが、やはり何をどこに挿入すればよいのかが
 わからずに、エラーばっかり出てしまいます。
 (それはもう具体例なんてあげられないほどに…)
 ヘルプを見るも、原因まではわかっても対処法がさっぱりわからないのです。

  やりたいことをもう一度整理します。
 ・既に用意されているテキストボックスの背景に画像を挿入
 ・画像のファイル名をテキストボックスが配置されているセルのすぐ下のセルに表示

    以上の繰り返し

  ※BJ様に教えて頂いた、
    「アクティブセルの大きさにテキストボックスを作成する」
     は折角ですが今回は使いません。
    (元画像が正方形の為、セルを正方形にしないと画像の縦横比率が変わってしまう)

  テンプレートを用意して、一つずつテキストボックスを選択して
 マクロの実行をしようと思います。
  どなたか、お手をお貸しいただけますでしょうか。

  (ブク)

 こんばんは!
こんな感じでどうでしょうか?
Option Explicit
Sub てすと()
Dim MyFile As Variant
Dim MyTextBox As Object
Dim MyRow As Long
Dim MyColumn As Long
If TypeName(Selection) <> "TextBox" Then Exit Sub
Set MyTextBox = Selection
MyFile = Application.GetOpenFilename( _
            "画像 ファイル (*.jpg), *.jpg", , "画像ファイルを選択して下さい。")
If VarType(MyFile) = vbBoolean Then Exit Sub
With MyTextBox
    .ShapeRange.Fill.UserPicture MyFile
    MyColumn = .TopLeftCell.Column
    MyRow = .BottomRightCell.Row
End With
Cells(MyRow, MyColumn).Value = Dir(MyFile)
Set MyTextBox = Nothing
End Sub
(SoulMan)


  SoulMan様 回答ありがとうございます。

  すごいです、ばっちし完璧です!
  結果的に丸投げみたいになってしまって大変心苦しいのですが、大変助かりました。

  これで作業が相当楽になると思います。ありがとうございました!

  (ブク)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.