戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
埋め込みオブジェクトの自動作成

    [195483] 埋め込みオブジェクトの自動作成-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ FlyingPan -(2023/01/05(01:33))
    □U R L/
      excelのworksheet内にpdfファイルを埋め込んでアイコン表示する処理を
      VBAで自動化したいと考えています。
      
      マクロ記録で当たりをつけたところ、
      
      ActiveSheet.OLEObjects.Add(Filename:="C:\Users\・・・\test.pdf" _
              , Link:=False, DisplayAsIcon:=True, IconFileName:= _
              "C:\Users\・・・\test.ico", IconIndex:=0, IconLabel:=""). _
              Select
      
      となり、OLEObjects.Addメソッドを調べてみると、width、heightの
      引数も使えそうだったので、試してみたのですが、上手くいきません。
      意図としては、width:=50,height:=50などとして、アイコンをデフォルトよりも
      小さく表示したいのですが、引数を追加すると、寧ろデフォルトよりも
      大きく表示され、且つ、数値を変えてもアイコンの大きさは変わりません。
      
      恐らく使い方が間違っているのでしょうが、サンプルコードがなかなか
      見つけられず、アドバイス頂けますと大変助かります。
      
      なお、最終的には、Dir関数を用いて、あるフォルダ内のpdfファイルを
      worksheet内に抽出して一覧表示させるのを、
      (現在はハイパーリンク付きのファイル名表示としているところ)
      埋め込みオブジェクトに切り替えたいと考えているのですが、
      埋め込む場所(セル)を指定する引数?の使い方もよくわからず、
      アドバイスを頂けますと大変助かります。
      
      宜しくお願い致します。
      
      環境:Windows11/Excel365
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他



      ++++++++++++++++++++
      OS      ⇒OTHER
      Version⇒OTHER
      ++++++++++++++++++++




    [195484] Re[1]: 埋め込みオブジェクトの自動作成-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2023/01/06(18:43))
    □U R L/
      ファイル名で挿入する場合はサイズ指定が出来ないようです。
      挿入後にサイズ変更ついでに位置も指定すれば良いでしょう。
      
      Sub test()
          Dim r As Range
          With ActiveSheet
              Set r = .Range("a1")
              With .OLEObjects.Add(Filename:="C:\Users\kazuo\Documents\test.pdf", _
                  Link:=False, DisplayAsIcon:=True, IconFileName:= _
                  "C:\Users\kazuo\Documents\test.ico", IconIndex:=0, IconLabel:="").ShapeRange
      '            .LockAspectRatio = msoFalse    '縦横比を変える場合
                  .Left = r.Left
                  .Top = r.Top
                  .Width = r.Width
      '            .Height = r.Width
              End With
          End With
      End Sub
      
      Excel2016


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195485] Re[2]: 埋め込みオブジェクトの自動作成-

    保留中です・・・ / 記事引用/メール受信=OFF■

    □投稿者/ FlyingPan -(2023/01/07(14:45))
    □U R L/

      kazuoさま

      有難うございます!できました。
      拡張余地のヒントも頂き、本当に助かりました。

      ちなみに、VBAとは外れてしまうのかも知れませんが、
      埋め込みオブジェクトのアイコン表示について、
      デフォルトだとオブジェクトの大きさ対比、縮小&上寄せ表示されると思いますが、
      オブジェクトの大きさと一致させて表示させることはできるものでしょうか。

      不躾な質問ですみません。




    [195486] Re[3]: 埋め込みオブジェクトの自動作成-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2023/01/07(17:12))
    □U R L/
      手作業であればトリミングすれば出来ます。
      
      Sub test()
          Dim r As Range
          With ActiveSheet
              Set r = .Range("a1")
              With .OLEObjects.Add(Filename:="C:\Users\kazuo\Documents\test.pdf", _
                  Link:=False, DisplayAsIcon:=True, IconFileName:= _
                  "C:\Users\kazuo\Documents\test.ico", IconIndex:=0, IconLabel:="").ShapeRange
                  With .PictureFormat '以下は適当です
                      .CropTop = 7
                      .CropBottom = 32
                      .CropLeft = 24
                      .CropRight = 24.5
                  End With
      '            .LockAspectRatio = msoFalse    '縦横比を変える場合
                  .Left = r.Left
                  .Top = r.Top
                  .Width = r.Width
      '            .Height = r.Width
              End With
          End With
      End Sub
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195487] Re[4]: 埋め込みオブジェクトの自動作成-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ FlyingPan -(2023/01/07(18:30))
    □U R L/

      kazuoさま

      早速に有難うございます。
      その柔軟な発想、本当にすごいです。

      とても勉強になりました。

      引き続き宜しくお願い致します。




    [195488] Re[5]: 埋め込みオブジェクトの自動作成-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2023/01/08(08:31))
    □U R L/
      FlyingPanさん、良ければ教えて下さい。
      
      何故、ハイパーリンクではダメなのでしょうか?
      (マウスカーソルの問題、クリックの仕方の問題などなど)
      
      Sub macro1()
          Dim shp As Shape
          Dim r As Range
          With ActiveSheet
              Set r = .Range("a1")
              Set shp = .Shapes.AddPicture("C:\Users\kazuo\Documents\test.ico", msoFalse, msoTrue, 0, 0, -1, -1)
              With shp
                  .Left = r.Left
                  .Top = r.Top
                  .Width = r.Width
              End With
              .Hyperlinks.Add Anchor:=shp, Address:="C:\Users\kazuo\Documents\test.pdf"
          End With
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [195489] Re[6]: 埋め込みオブジェクトの自動作成-

    記事引用/メール受信=OFF■

    □投稿者/ kazuo -(2023/01/09(07:29))
    □U R L/

      ボケボケです。
      質問は無かったことに願います。




    [195490] Re[7]: 埋め込みオブジェクトの自動作成-

    記事引用/メール受信=OFF■

    □投稿者/ FlyingPan -(2023/01/09(10:58))
    □U R L/

      Kazuoさま

      反応が遅れて失礼しました。

      職場で大人数で利用するフォルダ内のファイルを抽出すること
      (抽出後の一覧ファイル単独で利用)が目的なので、
      意図せずリンク切れが発生することを避けるため、
      オブジェクトを埋め込みたいと考えた次第です。
      答えになっておりましたでしょうか。

      宜しくお願いします。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G