• 締切済み

マクロでフォントサイズを縮小するには！？

現在、エクセルのマクロを勉強しています。 文字数がある一定を超えるとフォントサイズを縮小したいのですが、 どうもうまくいきません。 下記のような場合はどうしたらいいのでしょうか？？ file_name= "aa.xls" data_sheet= "data" Windows(file_name).Activate Worksheets(data_sheet).Activate Workbooks(file_name).Worksheets(data_sheet).Cells(i, 2).Select Selection.Copy Windows(file_name).Activate Worksheets(print_sheet).Activatee Workbooks(file_name).Worksheets(print_sheet).Range("J20").Select /*　ここに　フォントサイズを入れたらいいのでしょうか？？*/ Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

みんなの回答

  • subaru130
  • ベストアンサー率20% (66/326)
回答No.2

＃１です。打ち間違えに気づいたので訂正します 間違え セルの書式設定－配置－マジの制御－縮小して全体を表示するにレ点を入れ方法をとります 正しくは セルの書式設定－配置－文字の制御－縮小して全体を表示するにレ点を入れ方法をとります

aiurai54
質問者

お礼

さっそくの回答ありがとうございます。ただし、こちらの場合ですと上記の処理をするとエラーになってしまいました。 セルをまたがって表示したいため、セルを結合して、上記の処理を踏まえた上でマクロを動かしました。

  • subaru130
  • ベストアンサー率20% (66/326)
回答No.1

どうしてもマクロで組みたいのですか？ 私の方法は、マクロで組まず、セルの書式設定－配置－マジの制御－縮小して全体を表示するにレ点を入れ方法をとります。一番単純ですし J２０のサイズ変更は、 Range("J20").Font.size=20 この場合は拡大ですが２０に任意の数値を入れれば対応できます。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. Windows
  4. Windows NT・2000

関連するQ&A

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの（氏名や項目は違いますが）を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1（A9) →　sheet2(C2) sheet1（E9) →　sheet2(C5) sheet1（I9) →　sheet2(C8) ●項目1 sheet1（A8) →　sheet2(E3) sheet1（E8) →　sheet2(E6) sheet1（I8) →　sheet2(E9) ●項目2 sheet1（A18～D18の結合セル) →　sheet2(E2) sheet1（E18～H18の結合セル) →　sheet2(E5) sheet1（I18～L18の結合セル) →　sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか？？ ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • こんなマクロなんですが。

    下記のマクロでエクセルの表からデータ（文字列）を取得するようにしたいとおもっています。 Range("B23").Select Selection.Copy Range("F23").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("B24").Select Selection.Copy Range("F24").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B25").Select Application.CutCopyMode = False Sheets("September 03").Copy Before:=Sheets(2)　　　　　　　　　　←ここ Selection.Copy Sheets("September 03 (2)").Select　　　　　　　　　　　　　　　　　　　←ここ Sheets("September 03 (2)").Name = "September 10"　　　　　　　←ここ Range("B33").Select Application.CutCopyMode = False ActiveWindow.SmallScroll Down:=-15 Range("F12:L18").SelectEnd Sub と、まだ続くんですが、とりあえずここまでで。 番地のデータを取り込むようにしたいんですが、うまくいきません。 ←ここ っていうのがまさにそれです。

  • Excel vba selectが効かない

    2と3の2つのエクセルファイルがあります。縦の列を新しいファイルの横の行に コピーしていきたいプログラムです。 2のファイルの１シート目の"C8:C25" 3のファイルの１シート目の"C9:C65" を新しい1のファイルの１シート目の１行目にコピーするプログラムを 作っていますが１シート目はpasteされるのですが 3のファイル２シート目からselectの指定が"C9:C65"ではなく、B9からQ65の指定になってしまい思ったコピーができません（★のところ）、1シート目はうまくいっているのでどうして3のファイルの2シート目のからうまくいかないかわかりません。 5シートまででテストをしているのですが実際は各々255シートありもってくる列も 12列あります。とりあえずCの列だけ5シートで試してみています。 Dim i As Long Dim N As Long i = 1 N = 1 Do While i <= 5 ''C列''' Workbooks(2).Worksheets(i).Activate 　 '2のファイル Worksheets(i).Range("C8:C25").Select 　 'もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate 　 '1新しいファイル Range("C" & N).Select 　 '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True Workbooks(3).Worksheets(i).Activate 　 '3のファイル Workbooks(3).Worksheets(i).Range("C9:C65").Select 　'★もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate 　 '1新しいファイル Range("U" & N).Select 　 '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True i=i+1 N=N+1 LOOP

  • Visual Basicのエラー

    以下のプログラムで Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False の部分で「コピー領域と貼り付け領域の形が違うため、情報を貼り付けることができません。」というエラーが出てしまいます。 因みに、コピー元もコピー先も結合セルはありません。 どのように修正すればよいのでしょうか？ -------------------------------------------------------------------------------- Retu = Array(, 2, 17, 10, 9, 6, 7, 8) For N = 1 To 7 'Array関数Indexは０から始まるため、最後は抽出列数より１少ないものになる。 計上Sheet1.Activate 計上Sheet1.Range(Cells(5, Retu(N)), Cells(Sheet1件数MaxRow, Retu(N))).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 計上Sheet3.Activate 計上Sheet3.Cells(25, N).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

  • マクロ編集プリントアウト

    Sheets("Sheet1").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("Sheet1").Select Range("A9").Select Sheets("Sheet1").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("Sheet1").Select Range("A15").Select これで２回プリントアウトされていることになります。 ６行ずつ下方にデータが続いています。 データ行数は常に変化します。 dim i as long 　for i = 3 to 99 step 6 　　if worksheets("Sheet1").cells(i, "A") = "" then 　　　worksheets("Sheet2").range("A3:H8").value = worksheets("Sheet1").cells(i - 6, "A").resize(6, 8).value 　　　 　　end if 　next i を使用してうまくまとめることはできるでしょうか？

  • 【Excel VBA】シートコピー時、マクロコードはコピーしたくない

    ws.copy Before:=Workbooks(File).Sheets(1) Windows(File).Activate Cells.Select Selection.copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 上記コードで、シートのコピー・貼付を行っていますが、 コピー元シートのコードも引き継がれてしまいます。 引き継がれないようにコピーしたいのですが、可能でしょうか？ 可不可について、 可能ならばそのやり方（コード）を教えていただけないでしょうか？ よろしくお願いします。

  • マクロを使って不特定のファイルからコピー＆ペーストしたい(エクセル)

    エクセルのデータの必要な列を別のブックに入っているフォーマットにどんどん追加していけるようなマクロを作りたいと思っています。 マクロの自動記録を使ってみたのですが、特定のファイル名が入っているので、使えません。 中を見てみると Windows("A.xls").Activate Columns("b:b").select Selection.copy workbooks.open Filename:="B.xls" Windows("B.xls").Activate Range("D9").select Windows("A.xls").Activate Application.CutCopyMode = False Range("b:b").select Selection.copy Windows("B.xls").Activate Selection.Pastespecial Paste:=xlValues,Operation:=xlNone,SkipBlanks:=False,Transpose:=False . . . となっています。 このファイルAとなっている部分を、どのファイルでも実行できるようにしたいです。 後、ファイルBに貼り付けるときに一番最終行に追加していくにはどのような構文を足せばいいか教えていただきたいです。 初心者で質問の意図が伝わりにくかったらすみません.. よろしくお願いします。

  • マクロ構文エラー

    下記のマクロを記述していますが構文エラーが出ます 何が原因でしょうか。 Sub 会計データ送信() Sheets("工程生産バランス").Select file = "ml" & Cells(8, 12) & Cells(9, 13) & ".xls" Range("E5").Select If Range("E5") = "4月" Then Range("E6:E38").Select Selection.Copy Workbooks.Open Filename:="C:\sdata\ml\生産バランス.xls" Sheets("上期工程生産バランス").Select Range("E6:E38").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("E6").Select End If Windows("file").Activate　　→エラー箇所（インデックスが有効範囲にありません。） Sheets("工程生産バランス").Select Range("E5").Select End Sub 教えてください。

  • ＥＸＣＥＬマクロについて

    条件　シート名提供データＥ列の3行目からデータが入っています。 　　　ブランク以外のデータをコピーしてシート名WorkのＣ列の2行目から貼り付けたいので下記のマクロを書いていますがおかしい所 はないのでしょうか。教えてください。 いまいちCellsの使い方がわかりません。 出来たら下記の意味を教えてください。 brank = Worksheets("提供データ").Cells(gyo, 5).Text Range(Cells(3, 5), Cells(gyo, 5)).Select Sub 貼付() Dim gyo, brank Sheets("提供データ").Select Range("e3").Select gyo = 2 Do gyo = gyo + 1 brank = Worksheets("提供データ").Cells(gyo, 5).Text Loop While brank <> "" Range(Cells(3, 5), Cells(gyo, 5)).Select Selection.Copy Sheets("work").Select Range("c2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • VBAの貼り付け機能で質問させていただきます。

    VBAの貼り付け機能で質問させていただきます。 あるブックのシート全体の内容をコピーして、 別のブックに貼り付ける処理を作成していますが、 コピー元のシートにある画像だけが貼り付けされずに困っています。 ホームページで探してやってみましたが、どれもうまくいきませんでした。 ご存じの方がいましたら、助言をお願いします。 下の記述で画像以外は貼り付けできています。 Sub 貼り付け() Worksheets("コピー元シート").Select Cells.Select Selection.Copy Workbooks.Open Filename:="C:￥コピー先.xls" Workbooks("コピー先.xls").Activate Worksheets("コピー先シート").Select Cells.Select Selection.PasteSpecial Paste:=xlPasteAll, _ Operation:=xlNone, SkipBlanks:= False, _ Transpose:=False End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する