Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

239 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77660】Re:オートフィルターについて

γ - 15/11/18(水) 20:48 -


	引用なし

	パスワード

>VBAでは”～ではない”の場合、
>Criteria1:="<>4"
>とするようなので、
>修正してみたら、ますます多くの4のデータが
>混在してしまいました。

Criteria1:="<>4"
で問題ないはずです。
実際に動作させたコードを提示してください。

>A1032までではなく、その列全部を選択するにはどうすれば良いですか？
マクロ記録を取ってみて下さい。
　　Columns("A:A").Select
などとなりませんか？
なお、選択する目的は何ですか？
そのあとの作業に使うのであれば、たぶん選択する必要はないはずです。

・ツリー全体表示


	【77659】Re:VBA　画像圧縮

SEWING11 - 15/11/18(水) 18:14 -


	引用なし

	パスワード

ウッシ様
回答ありがとうございます！
私の書き方が悪いのでしょうね・・・申し訳ないです。
ブックのファイルサイズを下げることが勿論目的なのですが
貼付ける画像毎にサイズダウンをさせたいのです。

今回記述頂いたコードで目的とする動きは完璧にできています。
ここへ

'JPEG形式で保存
　　cht.Export Filename:=tmpP & Dir(myPic), filtername:="JPG"

または
Selection.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False

など、挿入した画像を一度カットし、形式を変えて貼付けという動作を
組込たいのです。

前に頂戴したコードで画像がサイズダウンされていましたので
それを元に試行錯誤してみます。
何度もアドバイス有難うございました！

・ツリー全体表示


	【77658】Re:シート内のリンクについて

古 - 15/11/18(水) 17:33 -


	引用なし

	パスワード

▼独覚さん：
早速のご回答、有難うございます！
終業の上、火曜日まで休暇を取ってしまったので
すぐに試すことが出来なくて悔しいですが、出社したら
必ず、成果をご報告します。
有難うございます！

・ツリー全体表示


	【77657】Re:シート内のリンクについて

独覚 - 15/11/18(水) 16:33 -


	引用なし

	パスワード

▼古さん：
VBAではなくワークシート関数ですがこういうのでいいのでしょうか。

「う」シートのE1セルに
=IF(C1="","",VLOOKUP(C1&"*",IF(COUNTIF(あ!A:A,C1&"*"),あ!A:B,い!A:B),2,FALSE))
と入力して下へフィルコピーしてください。

・ツリー全体表示


	【77656】シート内のリンクについて

古

- 15/11/18(水) 14:42 -


	引用なし

	パスワード

立て続けに、質問です。

”あ”、”い”、”う”の３つのシートがあります。
”あ”と”い”は別のテキストデータからもって来るデータです。

”あ”
A列は、「12345ﾄｳｷｮｳ」「67890ﾄｳｷｮｳ」のような表記になっています（A1～A22）
B列は、金額です。

”い”
A列は、「54321日本」「09876日本」のような表記になっていて（A1～A19）
B列は、金額です。

”う”シートは、集約するシートで
C列に「12345」や「54321」など、数字だけが入っていて
E列に　それに該当する金額を入れるようになっています。

この”う”のE列に　＝"あ"Sheet!A1 のようにリンクをつけても、毎回必ず
一つか二つは、おかしくなります。

毎月データ更新で”あ”と”い”のデータ位置が狂うからではあるのですが
すんなりリンクできる方法を教えてください。

申し訳ありません。

・ツリー全体表示


	【77655】オートフィルターについて

古

- 15/11/18(水) 14:22 -


	引用なし

	パスワード

初めまして。
マクロ初心者です。
「マクロで記録」を使ってマクロを作ったのですが、

Sub データ取得()
　　
　　Cells.Select
　　Selection.Copy
　　Sheets("抽出").Select
　　Range("A1").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　　　　:=False, Transpose:=False
　　Range("I8").Select
　　Application.CutCopyMode = False
　　Selection.AutoFilter
　　Selection.AutoFilter Field:=9, Criteria1:="=4", Operator:=xlAnd
　　Range("A1032").Select
　　Range(Selection, Selection.End(xlToRight)).Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Range(Selection, Selection.End(xlDown)).Select
　　ActiveWindow.SmallScroll Down:=-33
　　ActiveWindow.ScrollRow = 1
　　Selection.SpecialCells(xlCellTypeVisible).Select
　　Selection.Copy
　　Application.CutCopyMode = False
　　Selection.ClearContents
　　Selection.AutoFilter Field:=9

”抽出”シートの8行目に項目が並んでいます。
そして、I列で、オートフィルタで「4以外」を抽出したのですが
時々4のデータが混在されてしまいます。

VBAでは”～ではない”の場合、
Criteria1:="<>4"
とするようなので、修正してみたら、ますます多くの4のデータが
混在してしまいました。

どうしたら、4を除くデータだけを抽出できるのでしょうか。。

また、
Selection.AutoFilter Field:=9, Criteria1:="=4", Operator:=xlAnd
　　Range("A1032").Select

A1032までではなく、その列全部を選択するにはどうすれば良いですか？

どうか、ご教授ください。よろしくお願いいたします。

・ツリー全体表示


	【77654】Re:VBA　画像圧縮

ウッシ - 15/11/18(水) 14:05 -


	引用なし

	パスワード

こんにちは

結局、ブックのファイルサイズの圧縮の事のようなので、βさんのコードのように

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Dim myPic As Variant
　　Dim myRange As Range
　　Dim rX　As Single
　　Dim rY　As Single
　　Dim cht As Chart
　　　　
　　'挿入のセルを指定
　　
　　If Application.Intersect(Target, Range("D6,D23,D40")) Is Nothing Then Exit Sub
　　Cancel = True
　　
　　'写真挿入
　　myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
　　If myPic = False Then
　　　　Application.ScreenUpdating = True
　　　　MsgBox "画像を選択してください"
　　　　Exit Sub
　　End If
　　
　　Application.ScreenUpdating = False
　　　　
　　Set myRange = Target 'このセル範囲に収まるように画像を縮小する
　　　　
　　With ActiveSheet.Pictures.Insert(myPic)

　　　　.ShapeRange.LockAspectRatio = msoTrue
　　　　
　　　　.Width = myRange.Width
　　　　If .Height > myRange.Height Then .Height = myRange.Height
　　　　.Left = myRange.Left + myRange.Width / 2 - .Width / 2
　　　　.Top = myRange.Top + myRange.Height / 2 - .Height / 2
　　　　
　　End With
　　
　　Application.ScreenUpdating = True
　　Cancel = True

End Sub

とすれば良いと思います。

・ツリー全体表示


	【77653】Re:VBA　画像圧縮

SEWING11 - 15/11/18(水) 12:44 -


	引用なし

	パスワード

上記で書いた画像の右端と下端の隙・・ですが
画像挿入用のグラフを設置し、そこへ画像挿入。挿入後に画像コピーし
貼付け。なので、埋め込み用グラフのスペースと画像サイズが違いその隙間を
コピーし貼り付けているので、隙間？みたいなものが出来るのでしょうか・・・

画像挿入にあたり、埋め込み用グラフは必須なのかが判らず。。
もう少し、調べます。
ウッシ様、β様、ありがとうございました。

・ツリー全体表示


	【77652】Re:複数コンボックスへの処理について

ten - 15/11/18(水) 12:02 -


	引用なし

	パスワード

▼β さん：
>▼ten さん：
>
>
>With Worksheets(mySheet.Name).Controls("ComboBox" & i)
>
>これを
>
>With Worksheets(mySheet.Name).OLEObjects("ComboBox" & i).Object
>
>に変えて試してみてください。
>
>さらにいえば、mySheet が、対象シートオブジェクトそのものですから
>
>With mySheet.OLEObjects("ComboBox" & i).Object
>
>でいいですよ。

早速お返事頂き、ありがとうございました。
修正したところ、思い通りに動作しました。

色々調べるうちに「OLEObjects」を使うのかと思い試していましたが、
最後の「.Objects」が無かったせいか、うまく動きませんでした。

・ツリー全体表示


	【77651】Re:複数コンボックスへの処理について

β - 15/11/18(水) 11:33 -


	引用なし

	パスワード

▼ten さん：

With Worksheets(mySheet.Name).Controls("ComboBox" & i)

これを

With Worksheets(mySheet.Name).OLEObjects("ComboBox" & i).Object

に変えて試してみてください。

さらにいえば、mySheet が、対象シートオブジェクトそのものですから

With mySheet.OLEObjects("ComboBox" & i).Object

でいいですよ。

・ツリー全体表示


	【77650】複数コンボックスへの処理について

ten - 15/11/18(水) 10:41 -


	引用なし

	パスワード

はじめまして。

今、VBAを勉強中で、複数のワークシート上にそれぞれ４つのコンボボックスを置いて、
全てのコンボボックスで同じ選択肢を設定したいと思っています。
そこで、下記のようなコードを書いたのですが、
「オブジェクトはこのメソッドをサポートしていません」のエラーになります。
「Worksheets(・・).Controls(・・)」がまずいのは見当がつくのですが、
どのような書き方が正しいのでしょうか。

コードを書いているのは「ThisWorkBook」です。

For Each mySheet In Worksheets
　　　　For i = 1 To 4
　　　　　　　　With Worksheets(mySheet.Name).Controls("ComboBox" & i)
　　　　　　　　　　.AddItem "リンゴ"
　　　　　　　　　　.AddItem "みかん"
　　　　　　　　　　.AddItem "かき"
　　　　　　　　　　.AddItem "パイナップル"
　　　　　　　　　　.AddItem "バナナ"
　　　　　　　　　　.AddItem "ブドウ"
　　　　　　　　End With
　　　　Next i
Next

・ツリー全体表示


	【77649】Re:VBA　画像圧縮

SEWING11 - 15/11/18(水) 9:42 -


	引用なし

	パスワード

ウッシ様
回答ありがとうございます。
記載戴いたコードで試行しました。
ほぼ、望み通りに動きましたが何故か

　・圧縮後の貼り付け画像の左右はセンタリングされますが
　　上下はセンタリングされず、指定したセルより少し上に移動します。
　　　→指定セルより上ということは、値がマイナスという事ですよね。

　・貼り付けられた画像は圧縮済みなのですが、右端と下端に隙間？
　　説明しにくいのですが、右端・下端に透明部分がほんの僅か出ます。

あと少しかと思いますので頑張ってみます。

β様
回答ありがとうございます。
「違っていた」と記載したのは元画像のサイズが変わった事を指します。
解り難く、申し訳ありません。
上記、ウッシ様に記載戴いたコード部分を今回、β様に記載頂いたコードに
書き換えても動作しましたが、やはり上下のセンタリングと画像の隙？が
解決しません。

回答、ありがとうございました！

・ツリー全体表示


	【77648】Re:VBA　画像圧縮

β - 15/11/18(水) 8:49 -


	引用なし

	パスワード

▼SEWING11 さん：

横から失礼。

>ただ、今回求めている動作とは少し違いました。
>申し訳ありません。

違っているのは

１．画像圧縮
２．サイズ変更
３．圧縮・サイズ変更した結果をセル領域の中心に配置

この、どれですか？

もし、３．であれば

.Left = myRange.Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
.Top = myRange.Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置

としなければいけないのでは？

（私がご紹介したコードでは、そうしております）

・ツリー全体表示


	【77647】Re:VBA　画像圧縮

ウッシ - 15/11/18(水) 8:39 -


	引用なし

	パスワード

こんにちは

>目的は
>　指定セルをダブルクリック、フォルダを開き画像選択
>　画像挿入（指定したサイズまたはセルのｗｈ合わせ）、
>　挿入された画像を切り取り、形式（Jpeg）を指定して貼付
>　貼付た画像をセル内で上下センタリング
>としたいのです。

これは元々のコードで出来ているのでは？

ブックのファイルサイズが大きいなら、βさんのリンク先のコードで
出来ると思いますし。

質問の意味がよく分からないですが、

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Dim myPic As Variant
　　Dim myRange As Range
　　Dim rX　As Single
　　Dim rY　As Single
　　Dim cht As Chart
　　Dim tmpP As String
　　Dim tmpS As Worksheet
　　Dim tmpR As Range
　　　　
　　'挿入のセルを指定
　　
　　If Application.Intersect(Target, Range("D6,D23,D40")) Is Nothing Then Exit Sub
　　Cancel = True
　　
　　'写真挿入
　　myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
　　If myPic = False Then
　　　　Application.ScreenUpdating = True
　　　　MsgBox "画像を選択してください"
　　　　Exit Sub
　　End If
　　
　　Application.ScreenUpdating = False
　　
　　tmpP = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
　　Set tmpS = Worksheets.Add
　　ActiveWindow.DisplayGridlines = False
　　Set tmpR = tmpS.Range("A1")
　　
　　Set myRange = Target 'このセル範囲に収まるように画像を縮小する
　　　　
　　With Me.Shapes.AddPicture(myPic, False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height)
　　　　
　　　　rX = 0.85
　　　　rY = 1
　　　　
　　　　If rX > rY Then
　　　　　　.Height = .Height * rY
　　　　Else
　　　　　　.Width = .Width * rX
　　　　End If
　　　　
　　　　tmpR.RowHeight = .Height
　　　　tmpR.ColumnWidth = .Width / 6
　　　　
　　　　.Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
　　　　.Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
　　　　.ZOrder msoSendToBack '最背面へ移動
　　　　　　　　　　　　
　　　　tmpS.Shapes.AddPicture myPic, False, True, tmpR.Left, tmpR.Top, tmpR.Width, tmpR.Height
　　　　
　　　　.Delete
　　　　
　　End With
　　tmpS.Activate
　　tmpR.Select
　　tmpR.CopyPicture appearance:=xlScreen, Format:=xlPicture
　　'画像貼り付け用の埋め込みグラフを作成
　　Set cht = ActiveSheet.ChartObjects.Add(0, 0, tmpR.Width, tmpR.Height).Chart
　　'埋め込みグラフに貼り付ける
　　cht.Paste
　　'JPEG形式で保存
　　cht.Export Filename:=tmpP & Dir(myPic), filtername:="JPG"
　　'埋め込みグラフを削除
　　cht.Parent.Delete
　　
　　With Me.Shapes.AddPicture(tmpP & Dir(myPic), False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height)
　　　　
　　　　rX = 0.85
　　　　rY = 1
　　　　
　　　　If rX > rY Then
　　　　　　.Height = .Height * rY
　　　　Else
　　　　　　.Width = .Width * rX
　　　　End If
　　　　.Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
　　　　.Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
　　　　.ZOrder msoSendToBack '最背面へ移動
　　　　
　　　　Kill tmpP & Dir(myPic)
　　　　　　　　
　　End With
　　Application.DisplayAlerts = False
　　tmpS.Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
　　Cancel = True

End Sub

とかでは、余計にダメでしょうか？

・ツリー全体表示


	【77646】Re:VBA　画像圧縮

SEWING11 - 15/11/18(水) 0:15 -


	引用なし

	パスワード

ウッシ様

回答ありがとうございます。
記載頂いたコードを試しました。
元画像ファイルのサイズが変わるのですね！
　→こんな動作もできるのですね。

ただ、今回求めている動作とは少し違いました。
申し訳ありません。

目的は
　指定セルをダブルクリック、フォルダを開き画像選択
　画像挿入（指定したサイズまたはセルのｗｈ合わせ）、
　挿入された画像を切り取り、形式（Jpeg）を指定して貼付
　貼付た画像をセル内で上下センタリング
としたいのです。

.Cut
End With
Me.PasteSpecial Format:="図 (JPEG)"

等、記載しているのですが、うまく動作せず・・・
試行錯誤しております。
回答、ありがとうございました。

・ツリー全体表示


	【77645】Re:EXCEL VBAでの写真一括貼り付けについ...

daizuko

- 15/11/17(火) 9:52 -


	引用なし

	パスワード

▼β さん：

なるほどですね。
ありがとうございます。

・ツリー全体表示


	【77644】Re:VBA　画像圧縮

ウッシ - 15/11/17(火) 8:43 -


	引用なし

	パスワード

こんにちは

セルに貼り付けた画像のサイズにして良ければ、

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
　　Dim myF As Variant
　　Dim mySp As Object
　　Dim myAD1 As String
　　Dim myAD2 As String
　　Dim myHH As Double
　　Dim myWW As Double
　　Dim myHH2 As Double
　　Dim myWW2 As Double
　　Dim myPic As Variant
　　Dim myRange As Range
　　Dim rX　As Single
　　Dim rY　As Single
　　Dim cht As Chart
　　
　　'挿入のセルを指定
　　
　　If Application.Intersect(Target, Range("D6,D23,D40")) Is Nothing Then Exit Sub
　　Cancel = True
　　Application.ScreenUpdating = False
　　
　　'写真挿入
　　myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
　　If myPic = False Then
　　　　Application.ScreenUpdating = True
　　　　MsgBox "画像を選択してください"
　　　　Exit Sub
　　End If
　　
　　Set myRange = Target 'このセル範囲に収まるように画像を縮小する
　　Application.ScreenUpdating = False
　　With ActiveSheet.Shapes.AddPicture(myPic, False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height)
　　　　
　　　　rX = 0.85
　　　　rY = 1
　　　　
　　　　If rX > rY Then
　　　　　　.Height = .Height * rY
　　　　Else
　　　　　　.Width = .Width * rX
　　　　End If
　　　　.Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
　　　　.Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
　　　　.ZOrder msoSendToBack '最背面へ移動
　　　　
　　　　Kill myPic
　　　　　　　　
　　End With
　　
　　myRange.Select
　　myRange.CopyPicture appearance:=xlScreen, Format:=xlPicture
　　'画像貼り付け用の埋め込みグラフを作成
　　Set cht = ActiveSheet.ChartObjects.Add(0, 0, myRange.Width + 1, myRange.Height + 1).Chart
　　'埋め込みグラフに貼り付ける
　　cht.Paste
　　'JPEG形式で保存
　　cht.Export Filename:=myPic, filtername:="JPG"
　　'埋め込みグラフを削除
　　cht.Parent.Delete
　　
　　Application.ScreenUpdating = True
　　Cancel = True

End Sub

とかでどうでしょうか？

元画像を削除しますのでテスト環境で試して下さい。

・ツリー全体表示


	【77643】Re:EXCEL VBAでの写真一括貼り付けについ...

β - 15/11/16(月) 19:03 -


	引用なし

	パスワード

▼daizuko さん：

１）AddPictureを使う
２）Insertの後、それをクリップボードにコピーし、Insertしたものを削除した上で
　　クリップボードからペースト。

いずれかの方法で可能です。
別板ですが

//www.moug.net/tech/exvba/0120020.html

・ツリー全体表示


	【77642】EXCEL VBAでの写真一括貼り付けについて...

daizuko

- 15/11/16(月) 17:27 -


	引用なし

	パスワード

はじめまして。
どなたか分かる方がいましたらお答えいただければ幸いです。

EXCEL VBAにて複数の写真を一括貼り付けできるマクロを組みました。
しかし、私がつくったものは全てリンク貼り付けとなってしまいます。
仕事上、送受信やファイル名変更がたびたびあり、そのたびにリンクが切れてしまい大変不便です。
どのように変更すればリンク貼り付けではなくなるでしょうか。

また、こちらは出来ればでいいのですが、写真を貼り付けた際、写真のファイル名をセルに表示することは可能でしょうか。

よろしくお願いいたします。

Sub 複数の画像を挿入()
　
　　Dim strFilter As String
　　Dim Filenames As Variant
　　Dim PIC　　　 As Picture
　　
　　' 「ファイルを開く」ダイアログでファイル名を取得
　　strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
　　Filenames = Application.GetOpenFilename( _
　　　　　　　　　　FileFilter:=strFilter, _
　　　　　　　　　　Title:="図の挿入(複数選択可）", _
　　　　　　　　　　MultiSelect:=True)
　　If Not IsArray(Filenames) Then Exit Sub
　
　　' ファイル名をソート
　　Call BubbleSort_Str(Filenames, True, vbTextCompare)
　　
　　' 貼り付け開始セルを選択
　　Set Rng = Application.InputBox( _
　　　　Prompt:="貼り付け開始セルを入力してください", _
　　　　Title:="セル選択ダイアログ", _
　　　　Type:=8)
　　　　
　　　　Rng.Select
　　
　　' マクロ実行中の画面描写を停止
　　Application.ScreenUpdating = False
　　
　　L = InputBox("画像の間隔を入力してください")
　　N = InputBox("画像の高さを入力してください(行の高さ)")
　　
　　
　　' 順番に画像を挿入
　　For i = LBound(Filenames) To UBound(Filenames)
　　　　Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))
　　　
　　　　'-------------------------------------------------------------
　　　　' 画像の各種プロパティ変更
　　　　'-------------------------------------------------------------
　　　　With PIC
　　　　　　.Top = ActiveCell.Top　　　　' 位置：アクティブセルの上側に重ねる
　　　　　　.Left = ActiveCell.Left　　　' 位置：アクティブセルの左側に重ねる
　　　　　　.Placement = xlMove　　　　　' 移動するがサイズ変更しない
　　　　　　.PrintObject = True　　　　　' 印刷する
　　　　End With
　　　　With PIC.ShapeRange
　　　　　　.LockAspectRatio = msoTrue　 ' 縦横比維持
　　　　　　.Height = N
　　　　End With

　　　　ActiveCell.Offset(L).Select
　　
　　　　Set PIC = Nothing
　　Next i
　
　　' 終了
　　Application.ScreenUpdating = True
　　MsgBox i & "枚の画像を挿入しました", vbInformation

End Sub

' バブルソート（文字列）
Private Sub BubbleSort_Str( _
　　ByRef Source As Variant, _
　　Optional ByVal SortAsc As Boolean = True, _
　　Optional ByVal Compare As VbCompareMethod = vbTextCompare)
　
　　If Not IsArray(Source) Then Exit Sub
　
　　Dim i As Long, j As Long
　　Dim vntTmp As Variant
　　For i = LBound(Source) To UBound(Source) - 1
　　　　For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
　　　　　　If StrComp(Source(IIf(SortAsc, j, j + 1)), _
　　　　　　　　　　　 Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
　　　　　　　　vntTmp = Source(j)
　　　　　　　　Source(j) = Source(j + 1)
　　　　　　　　Source(j + 1) = vntTmp
　　　　　　End If
　　　　Next j
　　Next i

End Sub

・ツリー全体表示


	【77641】Re:VBA　画像圧縮

SEWING11 - 15/11/15(日) 21:38 -


	引用なし

	パスワード

＞β様
再び回答ありがとうございます。経緯の説明が不足していますね。申し訳ありません。画像ファイルの圧縮とは元データの事を指します。
写真整理で使用しているのですが、複数人へ配付して利用しております。
自分で使うのであれば、元画像データ（写真）をリサイズして貼り付けるのですが、配付先はＰＣに苦手な方が多く、何も考えず貼り付ければ勝手に圧縮されるというのが理想なのです。（工事写真なのですが、２０Ｍ超えのファイルを送り返してくるので・・・）
説明不足で、申し訳ありませんでした。

＞マナ様
回答ありがとうございます。
記載いただいた構文を追記してみます。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

239 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free