Excel VBA質問箱 IV

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

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


30052 / 76732 ←次へ | 前へ→

【51951】Re:文字列の表示上の長さ 再送
発言  ichinose  - 07/10/12(金) 19:36 -

引用なし
パスワード
   こんばんは。
訂正があったため再送です。

>セルのデータに外国人の名前のデータがあります。
>大文字小文字が混在しているデータです。
>
>この名前の文字列の表示される長さを知りたいのですが、
>具体的に言うと、そのデータを利用してWORDにリンクし
>表示されるようになっています。
>
>そのWORDに表示される名前の項目の幅がきまっており、
>長い人は文字幅の倍率を狭める(長体をかける)ことで
>対処したいです。
>
>VBAを利用してなんとか長体対象の長い名前データを判別
>したいのですが、なんとかできるものなのでしょうか?
>
>大文字小文字が混在していますし、表示される文字の長さ
>ですので、文字数の判別ではなんともなりません。

これは、Word側のフォントが全角:半角が2:1になっている
計算しやすいフォントを選択しないと面倒ですよね!!


もう一つは、ワード側でExcelワークシートの挿入を使って
Oleobjectとして、ワークシートを配置して、セルの書式を
「縮小して全体を表示する」に設定して運用する方法です。

Excelのセルの書式の「縮小して全体を表示する」を選択した時のような
表示になればよいのですよね!!


新規ブックの標準モジュールに

'=====================================================================
Sub main()
  Dim wk As Object
  Dim ole As Object
  Dim bk As Object
  ThisWorkbook.Worksheets("sheet1").Cells(1, 1).Value = "ICHINOSE EXCEL"
  Set wk = CreateObject("word.application")
  wk.Visible = True
  With wk.documents.Add
    Set ole = .Shapes.AddOLEObject(ClassType:="Excel.Sheet.8", LinkToFile _
         :=False).OLEFormat
    Set bk = ole.Object
    With bk.Worksheets("sheet1").Cells(1, 1)
      .ShrinkToFit = True
      .Formula = "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]Sheet1'!$a$1"
      End With
    '.SaveAs Filename:=ThisWorkbook.Path & "\文書1.doc"
    '.Close False
    End With
  'wk.documents.Open ThisWorkbook.Path & "\文書1.doc"
End Sub


上記のコードを含んだブックを名前を適当な名前で保存した後に
mainを実行してみてください。

ワードが起動され、ワードドキュメントにOLEとしてExcelワークシートが挿入されます。

OLEシートのセルA1に マクロを含むブックのSheet1のセルA1をリンクしました。
(OLEのシートのセルA1に「ICHINOSE EXCEL」と表示されます)

このOLEシートの体裁を整えて、セルA1だけ表示するように調整します。

Excel側のSheet1のセルA1の変更がワード側にも反映されるはずです。

試してみてください。

1 hits

【51931】文字列の表示上の長さ MKAT 07/10/12(金) 10:22 質問
【51936】Re:文字列の表示上の長さ ハチ 07/10/12(金) 13:31 発言
【51940】Re:文字列の表示上の長さ MKAT 07/10/12(金) 14:46 お礼
【51951】Re:文字列の表示上の長さ 再送 ichinose 07/10/12(金) 19:36 発言
【51952】Re:文字列の表示上の長さ りん 07/10/12(金) 20:16 発言

30052 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free