advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 228 for エラー値 #N/A (0.017 sec.)
エラー値 (861), #n/a (1385)
[[20240430181847]]
#score: 10842
@digest: 6182c8ba63f4355eb42412c3ba8f31f9
@id: 96678
@mdate: 2024-04-30T13:25:15Z
@size: 4050
@type: text/plain
#keywords: ass (33766), shirosuke (22550), エコ (19240), 像" (12838), 像¥ (9626), targetpath (8417), chdrive (7697), onedrive (7596), msotrue (6621), sheetbeforedoubleclick (6425), ー画 (6008), height (4810), linktofile (4603), savewithdocument (4603), scaleheight (4445), scalewidth (4226), 像フ (4006), 退避 (3866), width (3834), ル,* (3645), lockaspectratio (3323), target (3090), addpicture (3040), getopenfilename (2929), folder (2925), プ¥ (2910), 復旧 (2904), 画像 (2523), topleftcell (2279), mergearea (2180), chdir (1998), デス (1895)
『VBA 指定フォルダーから画像読み込み』(shirosuke)
表題の件でご教授お願いしたいと思います。 現在下記のVBAでダブルクリックをドキュメントが開きます。 今後ダブルクリックするとデスクトップにある指定したフォルダーが開くようにしたいのですがわかりません。 フォルダーの場所はC:¥Users¥shirosuke¥OneDrive¥デスクトップでフォルダー名は"エコー画像"です。 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim A As Variant Dim ASS As Object Dim I As String Dim J As String Cancel = True A = Application.GetOpenFilename _ ("画像ファイル,*.jpg;*.png", , "画像ファイルを選択して下さい", , False) If A = False Then Exit Sub End If For Each ASS In ActiveSheet.Shapes I = ASS.TopLeftCell.MergeArea.Address J = Target.Address If I = J Then ASS.Delete Next Set ASS = ActiveSheet.Shapes.AddPicture(Filename:=A, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) ASS.ScaleHeight 1, msoTrue ASS.ScaleWidth 1, msoTrue ASS.LockAspectRatio = msoTrue If ASS.Height / Target.Height > ASS.Width / Target.Width Then ASS.Height = Target.Height Else ASS.Width = Target.Width End If ASS.Left = Target.Left + (Target.Width - ASS.Width) / 2 ASS.Top = Target.Top + (Target.Height - ASS.Height) / 2 Set ASS = Nothing End Sub よろしくお願いします。 < 使用 Excel:Excel2021、使用 OS:Windows10 > ---- GetOpenFilenameを実行する直前に、 ChDirステートメントで、そのフォルダにカレントフォルダを移動させれば、 そのフォルダ内のファイルを選択する画面にできます。 なお、 1. 今のドライブがC以外なら、ChDriveを使ってドライブを移す必要があるかもしれません。 2. 現状のカレントフォルダをCurDirを使って求め、それを変数に退避しておき、 処理が終わったらもとに戻すとよいでしょう。 それ以外のところは見ていません。 # なお ASSという変数名は個人的には避けたいです。 # (辞書を引いてみてください。知らなければ気にならないかも知れないが) # sp(shapeの意味で)とかがよさそうです。 (xyz) 2024/04/30(火) 19:16:10 ---- xyzさんいつもありがとうございます。 ご指摘のあった ChDir "C:¥Users¥shirosuke¥OneDrive¥デスクトップ¥エコー画像¥エコー画像" A = Application.GetOpenFilename できました。 そのほかご指摘がありましたASという変数名 調べてみましたがデータ型とか 今後勉強していきたいと思います。ありがとうございました。 (shirosuke) 2024/04/30(火) 21:26:01 ---- 解決したようで何より。 私ならこんな風に書きますかね。 Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Const targetPath As String = "C:¥Users¥shirosuke¥OneDrive¥デスクトップ¥エコー画像¥エコー画像" Dim folder As String Dim fName As Variant Dim shp As Shape Dim ad1 As String Dim ad2 As String Cancel = True folder = CurDir '退避 'ChDrive targetPath 'ドライブをまたがっていれば ChDir targetPath fName = Application.GetOpenFilename _ ("画像ファイル,*.jpg;*.png", , "画像ファイルを選択して下さい", , False) 'ChDrive folder '復旧 ドライブをまたがっていれば。 ChDir folder '復旧 If fName = False Then Exit Sub ad2 = Target.Address For Each shp In Sh.Shapes ad1 = shp.TopLeftCell.MergeArea.Address If ad1 = ad2 Then shp.Delete Next Set shp = Sh.Shapes.AddPicture(Filename:=fName, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) With shp .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue .LockAspectRatio = msoTrue If .Height / Target.Height > .Width / Target.Width Then .Height = Target.Height Else .Width = Target.Width End If .Left = Target.Left + (Target.Width - .Width) / 2 .Top = Target.Top + (Target.Height - .Height) / 2 End With End Sub (xyz) 2024/04/30(火) 22:25:15 ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/202404/20240430181847.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97040 documents and 608197 words.

訪問者:カウンタValid HTML 4.01 Transitional