Excelじゆうちょう

Excelのお絵描きツール『りっぷ2(りっぷつぅ)』のサポートページ、まずは「はじめに」をご覧ください。 [NewEntry] [Admin]

記事更新カレンダー

06 « 2018-07 « 08
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -

やたらに多いカテゴリ

比較的新しい記事

新しいコメント

ありがたいブログ拍手

拍手コメント一覧(拍手はしない)

さみしいトラックバック

申し訳ないプロフィール

申し訳ない

管理人  [ 申し訳ない ]

pxivもやってます
リンクの一番上からのぞきに来てください
※閲覧にはユーザー登録が必要です

RSSってなんぞ?

広告は消せないらしい

FC2Ad

        --------       スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

        2011-03-28       アクティブセルの幅を変更

この前の記事 に追伸。

やっぱり実際にセル幅を変更するコードもあった方がいいですね。
というわけで、以下に紹介しておきます。
アクティブセルの縦と横をピクセルで指定した幅に変更します。
これなら、Windowsのフォントサイズ(DPI)を変更していても、標準のフォントを変更していてもちゃんと指定したピクセルから変換できるはずです。

ついでに、縦の設定横の設定を色分けしてみました。
文字幅がいかにまどろっこしいかがお分かりになるかと思います。


'【コードウインドウ】
Private Declare Function GetDeviceCaps Lib "gdi32" _
  (ByVal hDc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Sub ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDc As Long)

Public Sub setActiveCellSize() 'アクティブセルの幅を変更
Dim PixelToPoint_y As Single ,PixelToPoint_x As Single 'ピクセルをポイントへ変換
Dim hWnd As Long, hDc As Long 'ハンドル
Dim Row_size As Long, Col_size As Long, Font_width1 As Long, Font_width2 As Long
Row_size = CLng(Val(InputBox("アクティブセルの縦幅をピクセルで指定"))) '縦
Col_size = CLng(Val(InputBox("アクティブセルの横幅をピクセルで指定"))) '横
If 0 < Row_size And 0 < Col_size Then '幅は0ピクセル以上
  hWnd = Excel.Application.hWnd 'ハンドル取得
  hDc = GetDC(hWnd) 'ハンドル取得
  PixelToPoint_y = 72 / GetDeviceCaps(hDc, &H58&) '乗算でポイント変換
  PixelToPoint_x = 72 / GetDeviceCaps(hDc, &H58&) '除算でピクセル変換
  ReleaseDC hWnd, hDc 'ハンドル解放
  With ActiveCell
    .RowHeight = Row_size * PixelToPoint_y '縦(ポイントへ変換)
    .ColumnWidth = 1# '1文字分の列幅
    Font_width1 = CLng(.Width / PixelToPoint_x) '[余白]+[実幅]
    .ColumnWidth = 2# '2文字分の列幅
    Font_width2 = CLng(.Width / PixelToPoint_x) '[余白]+[実幅]+[実幅]
    If Font_width1 < Col_size Then '変更後が1文字分の幅より大きければ
      .ColumnWidth _
        = (Col_size - Font_width1) / (Font_width2 - Font_width1) + 1# '横(文字幅)
    Else
      .ColumnWidth = Col_size / Font_width1 '横(文字幅)
    End If

  End With
  MsgBox "縦 " & Row_size & " ピクセル、横 " & Col_size & " ピクセル"
Else
  MsgBox "セルの幅が不正です"
End If
End Sub


↓まずは実行↓
アクティブセル幅変更、実行

↓縦のピクセル数を入力(この後64を入力)↓
アクティブセル幅変更、縦

↓横のピクセル数を入力(この後32を入力)↓
アクティブセル幅変更、横

↓おしまい↓
アクティブセル幅変更、完了

このコードは最低限です、対象のセルを変更したりピクセル数の取得方法を変更したりすれば、そこそこ使い勝手が増すのではないでしょうか?
スポンサーサイト

コメント

コメントの投稿

管理者にだけ表示を許可  

トラックバック

http://likep.blog63.fc2.com/tb.php/207-18f2eb89

 | HOME | 

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。