エクセルの学校：全文検索：Hyper Estraier：セルの幅単位

Results of 1 - 1 of about 44 for セルの幅単位 (0.006 sec.)

セルの幅 (324), 単位 (3439)

[[20181207212356]]: #score: 9649; @digest: 0faea08b6721a538e392ddca182e03e9; @id: 78035; @mdate: 2018-12-14T10:37:43Z; @size: 17574; @type: text/plain; #keywords: 像名 (68049), 像処 (58647), チ横 (47049), 横6 (42173), 120dpi (34779), 96dpi (33273), 画像 (28280), 狭山 (25320), 度: (22277), （狭 (15669), 解像 (13376), 像度 (13262), ンチ (11555), cht (11448), 理（ (10996), shaperange (10607), 更前 (10099), 『画 (9689), chartobjects (9257), 移行 (7950), picture (7269), ピク (6953), 像の (6660), chart (5808), 取込 (5801), （前 (5680), 前） (5412), セン (5229), 更後 (4991), 名= (4880), single (4225), 像を (3814); 『画像とファイル名を取込と編集後の移行』（狭山）
お世話になります。以下の作業が可能でしたらマクロのコードを教えていただけないでしょうかデスクトップにフォルダー『画像処理（前）』と『画像処理（後）』があり.jpg画像は『画像処理（前）』の中に数百枚あります。他に『画像編集』という名前のエクセルブックがありその中のシート名は『変更』があります。行いたい事ですが『変更』シートでマクロを実行し『画像処理（前）』の画像をシートに取り込む画像の大きさは（高さ8センチ横6センチ）で全ての画像を挿入縦一列に取込画像の横のG列に取り込んだ画像の名前を書き出す。（画像の横に）画像を編集してH列に変更したい画像名を入れて画像を『画像処理（後）』に.jpgで移行する。その中で移行しないNG（写真撮影失敗）のものもありますので H列が空白の場合その画像は移行をしない。このような感じなのですが、どうぞ宜しくお願いいたします。＜使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- 確認すると、デスクトップにフォルダー『画像処理（前）』と『画像処理（後）』があり『画像処理（前）』の中に jpg画像が数百枚あります。他に『画像編集』という名前のエクセルブックがあり、その中に『変更』シートがあります。行いたい事は次のとおりです。 1.『画像処理（前）』の画像を『変更』シートに取り込む 2. 画像の大きさは（高さ8センチ横6センチ）で全ての画像を挿入、縦一列(F列?)に取込む 3. 画像の横のG列に、取り込んだ画像の名前を書き出す。（画像の横に） 4. 画像を編集してH列に変更したい画像名を入れて、 5. 画像を『画像処理（後）』に.jpgで移行する。 6. その中で移行しないNG（写真撮影失敗）のものもありますので H列が空白の場合その画像は移行をしません。 4.は手作業、それ以外をマクロにしたい、ということでしょうか。前半部分は、「画像をシートに挿入するマクロ」などと検索してみてください。いろいろ記事があります。例えば、 https://www.moug.net/tech/exvba/0120020.html 後半は、chartオブジェクトを使う方法が簡便でしょうか。最近の質問であれば、別掲示板ですが、「シート画像保存」 http://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=187978&rev=0 を参考にしてみて下さい。ご自分でトライしたうえで、不明な点を質問した方がよいと思います。（γ） 2018/12/08(土) 09:54 ---- （γ）様早速にありがとうございました。説明が下手で申し訳ございません。 2. 画像の大きさは（高さ8センチ横6センチ）で全ての画像を挿入、縦一列(F列?)に取込む縦一列(F列?)に取込むですが画像の左脇がB列です。 4.は手作業、それ以外をマクロにしたい、ということでしょうか。はい。そのとおりです。一つ入っていない事がありましたので・画像の横のG列に取り込んだ画像の名前を書き出す。（画像の横に）帰宅後に参考のURLを見させていただきます。（結構複雑になりそうで不安です）（狭山） 2018/12/08(土) 11:17 ---- 試していませんが考え方だけ前半部分は 1）高さ8センチ横6センチの空のchartオブジェクトを追加 2）画像を挿入を繰り返すと、後半部分が簡単にできそうな気がします。（マナ） 2018/12/08(土) 11:22 ---- ＞マクロのコードを教えていただけないでしょうかいつものとおり、質問ではなくコード作成依頼だという理解でよいのですよね。とりあえず、私は作成依頼をお受けするタイプではないので、依頼を受けていただける方が現れることをお祈りします。以下、そのような回答者さんが現れずに自分で考えてみる場合のヒントというかアイデアです。＞デスクトップにフォルダー『画像処理（前）』と『画像処理（後）』＞があり.jpg画像は『画像処理（前）』の中に数百枚あります。＞他に『画像編集』という名前のエクセルブックがあり＞その中のシート名は『変更』があります。＞行いたい事ですが＞『変更』シートでマクロを実行し『画像処理（前）』の画像を＞シートに取り込むこれをやるには、フォルダに入っている画像ファイルを検索して、ひとまずリストアップする必要がありますよね。それは↓がそのまま使えるのではないでしょうか? [[20181107234449]] 『JPGの画像の名前変更』（狭山）＞画像の大きさは（高さ8センチ横6センチ）で全ての画像を挿入縦一列に取込 Excelは通常、幅や高さをメートル法で管理してないので結構難しいとおもいます。ただ、アドインの導入に抵抗がなければ、セルの幅高さをセンチ単位で調整することが出来るようになるものが公開されているので導入されるとよいでしょう。＞画像の横のG列に取り込んだ画像の名前を書き出す。（画像の横に）＞画像を編集してH列に変更したい画像名を入れてこちらは、どのように編集するか不明ですが、G列に名前を書きだしているので、ハイパーリンクを設定しておいてクリックしたら画像編集ソフトが起動するようにしておくと便利だとおもいます。＞画像を『画像処理（後）』に.jpgで移行する。こちらは、よくわかりません。画像を"編集"したあとにjpgで保存するだけでは? 以上、アイデアだけですが提供します。（もこな2） 2018/12/08(土) 18:02 ---- 1個の画像ファイル限定の動作確認用サンプルです。実際には、 1）前半処理と後半処理は別のプロシージャにする 2）すべての画像について繰り返し処理するについて修正する必要があります。当然ですが、1個用コードが理解できないと先には進めないと思います。 Option Explicit Sub test() Dim ws As Worksheet Dim cht As Chart Dim T As Single, L As Single, W As Single, H As Single Dim デスクトップ As String Dim 変更前 As String, 変更後 As String Dim 画像名 As String デスクトップ = CreateObject("WScript.Shell").SpecialFolders("Desktop") 変更前 = デスクトップ & "¥画像処理（前）¥" 変更後 = デスクトップ & "¥画像処理（後）¥" Set ws = ActiveSheet L = ws.Columns("B").Left T = 0 W = 6 / 2.54 * 72 H = 8 / 2.54 * 72 画像名 = "エクセルの学校.jpg" Set cht = ws.ChartObjects.Add( _ Left:=L, Top:=T, Width:=W, Height:=H).Chart cht.ChartArea.Border.LineStyle = xlLineStyleNone cht.Parent.ShapeRange(1).TopLeftCell.Offset(, 5).Value = 画像名 cht.Shapes.AddPicture _ Filename:=変更前 & 画像名, _ LinkToFile:=False, SaveWithDocument:=True, _ Left:=-1, Top:=-1, Width:=W, Height:=H 画像名 = cht.Parent.ShapeRange(1).TopLeftCell.Offset(1, 5).Value If 画像名 <> "" Then cht.Export Filename:=変更後 & 画像名 End If End Sub （マナ） 2018/12/08(土) 19:02 ---- （マナ）様（マナ）様いつもありがとうございます。（マナ）様のを入れてみまして以下の部分にエラーが出てしまいましたしかしエクセルの学校.jpgと高さ8センチ横6センチは出てきました。 cht.Shapes.AddPicture _ Filename:=変更前 & 画像名, _ LinkToFile:=False, SaveWithDocument:=True, _ Left:=-1, Top:=-1, Width:=W, Height:=H 大変申し訳ないのですが自宅のPCが1台しかなく家族が使用するため明日の夜か月曜にテスト等を行うことになるかと思います。ただ、使用していない合間で行いたいと思います。（狭山） 2018/12/08(土) 19:32 ---- 「変更前」や「画像名」かの文字列が実際の文字列と全角、半角、大文字、小文字等まで全く同一になっていますか? （とおりすがり） 2018/12/09(日) 10:56 ---- ＞しかしエクセルの学校.jpgと高さ8センチ横6センチは出てきました。 ↓ここは、実際にあるファイル名に変更して動作確認してください。＞画像名 = "エクセルの学校.jpg" エラーと関係ないですが、ここも修正してください。＞cht.Parent.ShapeRange(1).TopLeftCell.Offset(, 5).Value = 画像名 ↓ cht.Parent.ShapeRange(1).TopLeftCell.Offset(1, 5).Value = 画像名 ‾‾ （マナ） 2018/12/09(日) 18:50 ---- (マナ）様ありがとうございます。コードの変更と実際のファイル名を入れて1つの画像と名前を書き出すことができました。自分でも色々なサイトで以下のコードを見つけて行ってみましたが Sub 写真を挿入する() Dim WS1 As Worksheet Dim WS2 As Worksheet Set WS1 = Worksheets("変更") '一覧貼り付け用シートをコピーして使う Worksheets("写真一覧用").Copy after:=WS1 ActiveSheet.Name = Format(Date, "YYMMDD") & Second(Now) Set WS2 = ActiveSheet Dim LCRN1 As Long LCRN1 = WS1.Cells(3, 9).End(xlDown).Row Dim PicName As String Dim PicID As String Dim N1 As Integer Dim Zahyou As Long Dim StrNum As Long Cells(1, 2).Select StrNum = 3 Zahyou = 96 '一つ一つの画像を貼り付けて移動させる For N1 = 3 To LCRN1 PicName = WS1.Cells(7, 2) & WS1.Cells(N1, 9) PicID = WS1.Cells(N1, 9) ActiveSheet.Pictures.Insert(PicName).Select With Selection .Top = Zahyou .Left = 50 .Width = 364 .Height = 226.6 End With Cells(StrNum, 1) = PicID StrNum = StrNum + 16 Zahyou = Zahyou + 384 Next End Sub Sub 画像一覧取得() Dim myFile As Variant 'ファイルを開く形式で、フォルダーを指定する myFile = Application.GetOpenFilename("jpgファイル(*.jpg),*.jpg") Dim vFileName As String Dim Num As Long '取得したパス名を記録しておく Cells(5, 2) = myFile Dim PathLength As Integer PathLength = Len(myFile) Dim N1 As Long N1 = 1 'ファイル名以外の部分を残すために最後の¥の位置を確認する Do Cells(6, 2) = Right(myFile, N1) N1 = N1 + 1 If Left(Cells(6, 2), 1) = "¥" Then Exit Do End If Loop Cells(7, 2) = Left(myFile, Len(myFile) + 1 - Len(Cells(6, 2))) vFileName = Dir(Cells(7, 2)) Columns(9).Delete Num = 3 'パスの中にあるファイル名をすべて書き出す Do Until vFileName = "" Cells(Num, 7) = vFileName Num = Num + 1 vFileName = Dir Loop End Sub 今回のこの件ですが大変申し訳ございませんが自分では無理と分かりました。日数もないため手作業にて行います。皆様、大変申し訳ございませんがこの件は終了にして下さい。また今後何かございましたら宜しくお願いいたします。（狭山） 2018/12/09(日) 20:49 ---- Option Explicit Sub 取り込み() Dim cht As Chart Dim T As Single, L As Single, W As Single, H As Single Dim 変更前 As String Dim 画像名 As String 変更前 = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥画像処理（前）¥" L = Columns("B").Left T = 0 W = 6 / 2.54 * 72 H = 8 / 2.54 * 72 画像名 = Dir(変更前 & "*.jpg") Do While 画像名 <> "" Set cht = ChartObjects.Add( _ Left:=L, Top:=T, Width:=W, Height:=H).Chart cht.ChartArea.Border.LineStyle = xlLineStyleNone With cht.Parent.ShapeRange(1).TopLeftCell.Offset(1, 5) .Value = 画像名 cht.HasTitle = True cht.ChartTitle.Formula = "=" & .Address(, , , True) End With cht.Shapes.AddPicture _ Filename:=変更前 & 画像名, _ LinkToFile:=False, SaveWithDocument:=True, _ Left:=-1, Top:=-1, Width:=W, Height:=H T = T + H 画像名 = Dir() Loop End Sub Sub 保存() Dim cho As ChartObject Dim 変更後 As String Dim 画像名 As String 変更後 = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "¥画像処理（後）¥" For Each cho In ChartObjects With Range(Mid(cho.Chart.ChartTitle.Formula, 2)) 画像名 = .Offset(, 1).Value If 画像名 Like "*.jpg" Then cho.Chart.Export Filename:=変更後 & 画像名 cho.Delete .Resize(, 2).ClearContents End If End With Next End Sub （マナ） 2018/12/11(火) 22:39 ---- （マナ）様すみません。投稿いただけるとは思ってませんでした。あれから手作業にて300枚位の作業をしていました。やはりマクロ実行にて行なえれば効率がいいなどと思っていました。今、行ってみましたところ Set cht = ChartObjects.Add( _ コンパイルエラー変数が定義されていませんと出ましての ChartObjectsの部分が黄色くなってしまいます。お返事をいただけたら嬉しいです。（狭山） 2018/12/12(水) 14:41 ---- シートオブジェクトを指定していないようなので、マクロはシートモジュールに貼ることを想定しているようですよ? マクロの編集画面を開いた場合には、このほうが楽ですし。標準モジュール上で動かすなら、ActiveSheet.ChartObjects のように、各オブジェクトの前にシートオブジェクトを明記してみてください。（???） 2018/12/12(水) 15:24 ---- （???）様ご教授ありがとうございました。私のミスでした。シートモジュールに貼ってエラーは大丈夫でした。感動です。大変失礼いたしました。もう一つ私のミスを発見してしまいました。画像処理（後）に移行された画像のプロパティをみましたら大きさ:283×378 幅:283ピクセル高さ:378ピクセル水平方向の解像度:120dpi 垂直方向の解像度:120dpi と小さくなってしまいまして画像処理（前）に入っているのと同じ大きさで移行は難しいでしょうか大きさ:480×640 幅:480ピクセル高さ:640ピクセル水平方向の解像度:96dpi 垂直方向の解像度:96dpi 当初、要望をお伝えするのを忘れていたのが・・反省しております。申し訳ございません。（狭山） 2018/12/12(水) 18:52 ---- 確認のため、新しいブックで以下を動かしてみてください。 Sub test() Dim OBJ As Object With CreateObject("WbemScripting.SWbemLocator") For Each OBJ In .ConnectServer.ExecQuery("Select * From Win32_DisplayConfiguration") MsgBox OBJ.LogPixels & " DPI", vbInformation, "画面解像度" Next OBJ End With End Sub おそらく、これが120DPIになっているのかと思います。この場合、マナさんの取り込みプロシジャの画像サイズ指定している箇所を、以下のように変えてみてください。 W = 480! * 72 / 120 H = 640! * 72 / 120 ただし、これでは120DPIの画面で見ると480x640になるだけで、96DPIにはなりません。（今見ている環境のDPIが記録されてしまうため）これを画面とは無関係に自由に指定するならば、現在のChartObjectsによる変換方法は止めて、GDI++というAPIを駆使した、とても難しいコーディングにする必要があるので、DPIについては諦めるのが良いと思いますよ。（手作業でもDPI変更は難しいですし、元の要望から外れすぎです）（???） 2018/12/13(木) 10:55 ---- なお、120DPIの画面に拘らなければ、96DPIの画面を用意する（文字サイズを標準にすれば96DPIかな?）事で、目的に適った出力ができるかと思いますよ。（???） 2018/12/13(木) 11:09 ---- （???）様お返事が遅くなり申し訳ございません。沢山のご教授ありがとうございます。早速にご指示のSub test()を行いましたら 96DPI と出ました。また、 W = 480! * 72 / 120 H = 640! * 72 / 120に変更し実行しましたところ以下のようになりました。大きさ:480×640 幅:480ピクセル高さ:640ピクセル水平方向の解像度:120dpi 垂直方向の解像度:120dpi やはり水平方向の解像度と垂直方向の解像度は取り込む前の画像と同じにはならないのですねすみませんが画像の中にセルのデータを画像として貼り付けて（画像の左下です）グループ化にしたいのですが例としまして1枚だけ記録を取ってみました。全てを行うことは可能でしょうか Sub 図として貼り付け() ' ' 図として貼り付け Macro ' ' Range("J2:J7").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Copy ActiveSheet.Pictures.Paste.Select ActiveSheet.Shapes.Range(Array("Picture 107")).Select Selection.ShapeRange.IncrementLeft -537.6 Selection.ShapeRange.IncrementTop 120 Selection.ShapeRange.ScaleHeight 0.8121546961, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 0.8454545455, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 1.1182795699, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.Height = 85.0393700787 Range("F9").Select ActiveSheet.Shapes.Range(Array("Picture 107")).Select ActiveSheet.Shapes.Range(Array("Picture 107", "Chart 1")).Select ActiveSheet.Shapes.Range(Array("Picture 107", "Chart 1")).Select Selection.ShapeRange.Group.Select ActiveSheet.Paste ActiveSheet.Shapes.Range(Array("Picture 109")).Select Application.CutCopyMode = False End Sub J2:J7を範囲を選択して塗りつぶし白を選択この範囲をコピーして図として貼り付け画像とこの図を選択してグループ化を記録しました。また画像にする選択範囲は全部書けませんが J2:J7 J14:J19 J27:J32 J39:J44 という範囲です。何度も申し訳ございませんがご教授お願いいたしいます。（狭山） 2018/12/13(木) 20:15 ---- すみません。図の大きさですが高さ5.2 幅3.6 です。何度も申し訳ございません。（狭山） 2018/12/13(木) 20:22 ---- DPI確認用マクロで96DPIと表示されたのならば、画面は本来96DPIだと思われます。WINDOWSの文字サイズ設定を、大きなフォントに変えていませんか? 標準にしてみてください。（今より文字が小さくなって読みにくくなるでしょうけど、96DPIを取るか、文字サイズを取るかの2択です）そして、グループ化は話が別ですし、具体的な部分を全部書いていないせいか、要件がいまいちよく判りません。また、マナさんがChartObjectsを使ったのは画像サイズ変換のためであり、変換後画像は普通に張り付ければシンプルにグループ化できますから、いろいろ試してみると良いでしょう。 ActiveSheet.Shapes.Range(Array("Picture 107", "Picture 109")).Select 'こんな感じ（???） 2018/12/14(金) 09:53 ---- （???）様ご教授ありがとうございました。 96DPIを優先したいと思います。グループ化は話が別ですしその通りでした。申し訳ございませんでした。少し試しながら行いたいと思います。最後に以下が行いたかった事です。画像は工事用の画像で画像の中に（左下）工事名等の情報を背景を白で文字を黒にて白板を貼り付ける貼り付けを行いたかったのです。 J2:J7の6つのセルに他のシートから反映されている関数が入っていますこのJ2:J7を1つの図としてから画像の左下の角に合わせて貼り付けて画像とその図をグループ化ループ化にして移行をしたかったのです。ただ全てを貼り付けるわけではなく例えばK列のどこかに行こうかどうかの〇等を付け上記の作業を行いたいと思っていました。このような感じでした。本当にありがとうございました。（狭山） 2018/12/14(金) 19:37 ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/201812/20181207212356.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ