Microsoft Access ClubAccess超初心者対象ForumAccess初級者対象ForumAccess初・中級者対象ForumAccess VBA Tips ForumDAO、ADO、SQL Forum

     

No35005.EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい

タイトルEXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35005
投稿日: 2005/07/28(Thu) 21:36
投稿者: ヒロト
OS:Windows2000
Access Version:2000

過去ログを探しても見つからないので投稿させて頂きます。お力貸して下さい。

VBAにてEXCELを起動し、指定のsheetの指定のセルに画像を貼り付けるようにコードを書いています。
(画像はCドライブ内にXXX.bmpというように保存してあります。)

しかし、貼り付けた結果を見ると、画像のサイズが一定ではないせいか小さいものや大きいものバラバラに
表示されてしまいます。

そこで、一定のサイズで表示するようにコードで記述する為にはどうすればよいか考えたのですが
分かりません。どうしたらよろしいでしょうか。

タイトルRe: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35010
投稿日: 2005/07/28(Thu) 22:20
投稿者: みるく
サイズを変更するところをマクロ記録するとコードが生成されませんか?
生成されたら、それを参考にしてみるとよいかと。



ただ ...

> (画像はCドライブ内にXXX.bmpというように保存してあります。)
>
ビットマップだとサイズを変えたら見づらくなりませんでしたっけ?

タイトルRe^2: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35016
投稿日: 2005/07/28(Thu) 23:57
投稿者: ヒロト
> サイズを変更するところをマクロ記録するとコードが生成されませんか?
> 生成されたら、それを参考にしてみるとよいかと。

マクロ記録からコード記述していますが、貼り付けまでは行いますが、サイズの変更がききません。
コードは下記のように書いています。どこが悪いんでしょうか・・

Dim EXAP As Excel.Application
Dim strBmp As String

strBmp = ファイルのあるアドレスを指定

With EXAP
.Range("B1").Select
.Range("B1").Activate
.ActiveSheet.Pictures.Insert(strBmp).Select
.Selection.ShapeRange.ScaleWidth 0.55, False, 0
.Selection.ShapeRange.ScaleHeight 0.55, False, 0
End With

> > (画像はCドライブ内にXXX.bmpというように保存してあります。)
> >
> ビットマップだとサイズを変えたら見づらくなりませんでしたっけ?

見づらくなるのは構わないと思っています。

タイトルRe^3: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35019
投稿日: 2005/07/29(Fri) 01:44
投稿者: みるく
SelectやActivateが乱舞しているのがどうも気になりますが。

マクロ記録をそのまま使ってしまうとそうなるので、

> 参考に
>
なのです。

Sub Temp()
Const strBmpPath As String = "C:\BMP1.BMP"
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Set xls = CreateObject("Excel.Application")
Set wkb = xls.Workbooks.Add
With wkb.Worksheets(1).Pictures.Insert(strBmpPath).ShapeRange
.ScaleWidth 3.81, False, 0 'msoFalse, msoScaleFromTopLeft
.ScaleHeight 3.81, False, 0 'msoFalse, msoScaleFromTopLeft
.Left = wkb.Worksheets(1).Range("B1").Left
End With
xls.UserControl = True
xls.Visible = True
Set wkb = Nothing
Set xls = Nothing
End Sub

とかにしてみたらどうなりますか?
(こちらでは動作確認済)

タイトルRe^4: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35053
投稿日: 2005/07/29(Fri) 16:37
投稿者: ヒロト
みるくさん、度々有難う御座います。

> Sub Temp()
> Const strBmpPath As String = "C:\BMP1.BMP"
> Dim xls As Excel.Application
> Dim wkb As Excel.Workbook
> Set xls = CreateObject("Excel.Application")
> Set wkb = xls.Workbooks.Add
> With wkb.Worksheets(1).Pictures.Insert(strBmpPath).ShapeRange
> .ScaleWidth 3.81, False, 0 'msoFalse, msoScaleFromTopLeft
> .ScaleHeight 3.81, False, 0 'msoFalse, msoScaleFromTopLeft
> .Left = wkb.Worksheets(1).Range("B1").Left
> End With
> xls.UserControl = True
> xls.Visible = True
> Set wkb = Nothing
> Set xls = Nothing
> End Sub
>
> とかにしてみたらどうなりますか?
> (こちらでは動作確認済)

上記コードを使用し、ためした所、1枚貼り付けるまでは出来ました。
言い忘れていて申し訳なかったんですが、この処理にはループを使用し、Cドライブ内にある、複数毎の
BMPファイルを一定のサイズでEXCELに貼り付けるという処理を行っています。

そうすると、それぞれの元画像のサイズが違う為か、一定のサイズになりません。。。

どうすれば良いでしょうか。。度々すみません。

タイトルRe^5: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35057
投稿日: 2005/07/29(Fri) 21:47
投稿者: みるく
> そうすると、それぞれの元画像のサイズが違う為か、一定のサイズになりません。。。
>
ヘルプ見てます?
「ScaleWidth」も「ScaleHeight」もどちらもサイズを何倍にするかを指定するわけでしょ?


> > .Left = wkb.Worksheets(1).Range("B1").Left
~~~~
関連項目を調べれば、幅や高さも出てくると思いますが。
特定のサイズを指定するのであればそっちではないのですか?


あと、

> Pictures.Insert
>
以外にも

Dim wkb As Excel.Workbook
(中略)
wkb.Worksheets(1).Shapes.AddPicture _
FileName:="C:\BMP1.BMP", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue _
, Left:=xxx, Top:=xxx, Width:=xxx, Height:=xxx

Shapes.Add系の処理方法があると思いますが、そちらは?
もともと、マクロ記録したらこっちが出てきそうな気がするのですけど。


(上記いずれも動作その他については未確認。)

タイトルRe^6: EXCELへ貼り付ける画像(.bmp)のサイズをVBAにて変更したい
記事No: 35087
投稿日: 2005/07/31(Sun) 16:20
投稿者: ヒロト
返事遅くなってすみません。

> ヘルプ見てます?
> 「ScaleWidth」も「ScaleHeight」もどちらもサイズを何倍にするかを指定するわけでしょ?
はい、ヘルプは見てます。確かにどちらともサイズを縮小したり、拡大したりするメソッドなので
今回の場合、貼り付け元のbmpファイルサイズがそれぞれ違うのでこれでは出来ないのではないかと
思ったのですが、その方法が分からなかったんです。

>
> > > .Left = wkb.Worksheets(1).Range("B1").Left
> ~~~~
> 関連項目を調べれば、幅や高さも出てくると思いますが。
> 特定のサイズを指定するのであればそっちではないのですか?
その通りです。でも関連項目の欄がヘルプでは出てこず、分かりませんでした。

> > Pictures.Insert
> >
> 以外にも
>
> Dim wkb As Excel.Workbook
> (中略)
> wkb.Worksheets(1).Shapes.AddPicture _
> FileName:="C:\BMP1.BMP", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue _
> , Left:=xxx, Top:=xxx, Width:=xxx, Height:=xxx
>
> Shapes.Add系の処理方法があると思いますが、そちらは?

AddPicture をヘルプで調べ、こちらで対応する事が出来ました。
left、width、heightのサイズはそれぞれ固定なのでtopの位置を都度、微調整してあげました。
コードは略してありますが、下記の通りです。

Dim wkb As Excel.Workbook
Dim sinLine As Single
(中略)
Do While xxx= False
(中略)
sinLine=100

With wkb.Worksheets(1).Shapes.AddPicture _
FileName:="C:\BMP1.BMP", LinkToFile:=False, SaveWithDocument:=True _
, Left:=50, Top:=sinLine, Width:=70, Height:=50
End With
sinLine = sinLine + xx
xx.MoveNext
Loop

> もともと、マクロ記録したらこっちが出てきそうな気がするのですけど。
マクロの記録を行うとPictures.Insertの方しか出てきませんでした。
やり方が悪かったんですかね。。

有難う御座いました。
解決とさせて頂きます。


このAccessフォーラム過去ログ集は、Microsoft Access Club が運営しています

注目のモンスター専用サーバーからお買い得プランまで幅広くそろえています。cPanel、PLESK、WEBMINまでお任せ下さい。
注目のモンスター専用サーバーからお買い得プランまで幅広い。
cPanel、PLESK、WEBMINまでお任せ下さい。

 

ページの先頭へ 前ページへ戻る