エクセル2000、Win2000です。
いくつかのセルを横に結合し、セル内で「折り返して全体を表示する」にしています。
セルを結合してない場合は、入力文字数が多くなっても行の高さを自動調整にすれば、ちゃんと折り返して全部表示されますが、結合したセルの場合は、自動調整がきかず、
いちいち手動で調整しなくてはいけません。
1.結合セルでも自動調整する方法はないですか?
2.ない場合、VBAで行の高さを変えてみようと思いますが、セル内で折り返しているかどうか、および何行に折り返されているかはどう判別すればいいでしょうか?
No.2
- 回答日時:
merlionX さん、こんにちは。
ちょっと考えてみました。
以下のプロシージャは単独で動くものですが、この下にある、Selection を、Target[正しくは、With Target.Cells(1) ] にして、イベント(Worksheet_Change())に入れてみたらいかがでしょうか?一応、これは、フォント9~12 の書式スタイルで検証してみました。
ただ、確か、Excelでは、印刷する場合に、調整高が連続した行にあると、セルの中の最後の行が隠れてしまうという現象がありますので、「縦の調整」に、数字を入れて調整してみてください。だいたい、調整高の余分として、そのフォントの高さの1~1.5倍(例:フォント11で、13.5) ぐらいを入れてみてください。
'フォントの高さの定数
Private Const Font12Ht = 14.25
Private Const Font11Ht = 13.5
Private Const Font10Ht = 12
Private Const font9Ht = 11.25
Sub MergeCells_Alignment()
Dim myStr As String
Dim myStrLength As Long
Dim lineHeight As Double
Dim ea As Variant
Dim i As Long
Dim lineStrNum As Long
Dim wdth As Long
'幅の調整
Const WidthAdjustment As Double = 1.5
'縦の調整
Const HightAdjustment As Double = 0 'フォント高×1.0~1.5
'
With Selection.Cells(1)
If .MergeCells = False Then Exit Sub
For i = 1 To .MergeArea.Count
wdth = wdth + Int(.Offset(, i - 1).ColumnWidth + WidthAdjustment)
Next i
For Each ea In .MergeArea.Value
myStr = myStr & ea
Next
myStrLength = LenB(StrConv(myStr, vbFromUnicode))
lineStrNum = myStrLength / wdth
Select Case .Font.Size
Case 12
lineHeight = Font12Ht
Case 11
lineHeight = Font11Ht
Case 10
lineHeight = Font10Ht
Case 9
lineHeight = font9Ht
End Select
.RowHeight = lineHeight * Int(lineStrNum) + HightAdjustment
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
End Sub
No.1ベストアンサー
- 回答日時:
自前のコードを書くしかないようです。
一例ですが、参考までに・・・。
'定数定義
Option Explicit
Public Const vbShiftMask As Integer = 1 'キーコードマスク定数。(システム定数にないため、ユーザー定義)
Public Const vbCtrlMask As Integer = 2 ' 〃
'↓実行時エラーコード。
Public Const pErrOutOfIndex As Long = 9 'インデックスが有効範囲にありません。
Public Const pErrFileNotFnd As Long = 53 'ファイルが見つかりません。
Public Const pErrCreateObj As Long = 429 'CreateObject | GetObject (インスタンスの生成) に失敗。
Public Const pErrPrinterNotAvailable As Long = 2212 'プリンタが無効です。
Public Const pErrReadMdl As Long = 2601 'モジュールの読み取り権限がない。
Public Const pErrUseObj As Long = 3033 'オブジェクト <オブジェクト名> を使用する権限がありません。
Public Const pErrReadObj As Long = 3110 'テーブルまたはクエリー <名前> の定義を読み取る権限がないため、定義を読み取ることができませんでした。
Public Const pErrPrpNotFnd As Long = 3270 'プロパティが見つかりません。
Public Const pErrCantReadJetDb As Long = 3343 'データベースを認識できません。
Public Const pErrMdlNotFnd As Long = &H8007007E '指定されたモジュールが見つかりません。
Public Const xlsMaxColumns As Long = &H100& 'Excelシートで利用可能な最大列数。
Public Const xlsMaxRows As Long = &H10000 ' 〃 最大行数。
'Excel列座標変換ユーティリティ
Option Explicit
Public Function GetXlsPosYStr(ByVal lngPos As Long) As String
'Excelの横座標数値(1~256)を文字列("A" ~ "IV")に変換。
Select Case lngPos
Case 1 To 26
GetXlsPosYStr = Chr$(lngPos + 64)
Case 27 To xlsMaxColumns
GetXlsPosYStr = Chr$((lngPos - 1) \ 26 + 64) & Chr$((lngPos - 1) Mod 26 + 65)
Case Else
Err.Raise pErrOutOfIndex
End Select
End Function
Public Function GetXlsPosYLong(ByVal strPos As String) As Long
'Excelの横座標文字列("A" ~ "IV")を数値(1~256)に変換。
Dim lngPos As Long
strPos = UCase$(Trim$(strPos))
Select Case Len(strPos)
Case 1
lngPos = Asc(strPos) - 64
Case 2
lngPos = (Asc(Left$(strPos, 1)) - 64) * 26 + Asc(Right$(strPos, 1)) - 64
If lngPos > xlsMaxColumns Then
Err.Raise pErrOutOfIndex
End If
Case Else
Err.Raise pErrOutOfIndex
End Select
GetXlsPosYLong = lngPos
End Function
'AutoFitの拡張版。(結合セルに対応)
Option Explicit
Public Enum AutoFitDirection
enmColumn '列
enmRow '行
End Enum
Public Function AutoFitEx( _
ByRef wksht As Excel.Worksheet, _
ByRef rngTarget As Excel.Range, _
Optional ByVal Direction As AutoFitDirection = enmRow, _
Optional ByVal keepDefault As Boolean = True)
Dim hAlign As Excel.Constants
Dim vAlign As Excel.Constants
Dim strAddress As String
Dim strTmp As String
Dim strStClmn As String
Dim strEdClmn As String
Dim lngStClmn As Long
Dim lngEdClmn As Long
Dim lngStRow As Long
Dim lngEdRow As Long
Dim lngPos As Long
Dim i As Long
Dim clmnWdthSum As Double
Dim StClmnWdth As Double
Dim orgClmnWdth As Double
Dim RowHghtSum As Double
Dim StRowHght As Double
Dim orgRowHght As Double
hAlign = rngTarget.HorizontalAlignment
vAlign = rngTarget.VerticalAlignment
strAddress = rngTarget.MergeArea.Address(ReferenceStyle:=xlA1)
strStClmn = Mid$(strAddress, 2)
strTmp = Mid$(strStClmn, InStr(strStClmn, "$") + 1)
lngPos = InStr(strTmp, ":")
If lngPos <> 0 Then
lngStRow = CLng(Left$(strTmp, lngPos - 1))
lngEdRow = CLng(Mid$(strAddress, InStrRev(strAddress, "$") + 1))
Else
lngStRow = CLng(Mid$(strStClmn, InStr(strStClmn, "$") + 1))
lngEdRow = lngStRow
End If
strStClmn = Left$(strStClmn, InStr(strStClmn, "$") - 1)
strEdClmn = Mid$(strAddress, InStr(strAddress, ":") + 2)
strEdClmn = Left$(strEdClmn, InStr(strEdClmn, "$") - 1)
lngStClmn = GetXlsPosYLong(strStClmn)
lngEdClmn = GetXlsPosYLong(strEdClmn)
rngTarget.UnMerge
With wksht
If Direction = enmRow Then
'高さの自動調整
StClmnWdth = .Columns(lngStClmn).ColumnWidth
clmnWdthSum = 0
For i = lngStClmn To lngEdClmn
clmnWdthSum = clmnWdthSum + .Columns(i).ColumnWidth
Next i
.Columns(lngStClmn).ColumnWidth = clmnWdthSum
orgRowHght = .Rows(lngStRow).RowHeight
.Rows(lngStRow).AutoFit
If keepDefault Then
If .Rows(lngStRow).RowHeight < orgRowHght Then
.Rows(lngStRow).RowHeight = orgRowHght
End If
End If
.Columns(lngStClmn).ColumnWidth = StClmnWdth
Else
'幅の自動調整
StRowHght = .Rows(lngStRow).RowHeight
RowHghtSum = 0
For i = lngStRow To lngEdRow
RowHghtSum = RowHghtSum + .Rows(i).RowHeight
Next i
.Rows(lngStRow).RowHeight = RowHghtSum
orgClmnWdth = .Columns(lngStClmn).ColumnWidth
.Columns(lngStClmn).AutoFit
If keepDefault Then
If .Columns(lngStClmn).ColumnWidth < orgClmnWdth Then
.Columns(lngStClmn).ColumnWidth = orgClmnWdth
End If
End If
.Rows(lngStRow).RowHeight = StRowHght
End If
With .Range(strAddress)
.Merge
.HorizontalAlignment = hAlign
.VerticalAlignment = vAlign
End With
End With
End Function
さっそくありがとうございます。
ものすごい大仕掛けが必要になりますねえ!!!
目が回りそうです(笑)
勉強させていただきます。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/12/26 12:05
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/12/26 14:27
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/01/06 08:39
- Excel(エクセル) エクセル、画像ファイル名の書かれたセル(複数個所)に画像を一括で表示させる方法 1 2023/04/19 00:19
- Excel(エクセル) エクセルでA列セル内で折り返すことなく、文字列を、B列C列・・・側に一行に 2 2022/07/23 02:02
- Excel(エクセル) IF 関数で「〇〇 という文字を含む場合」の分岐処理で表示された数字はSUMで数字集計できますか? 3 2022/08/02 16:29
- Excel(エクセル) エクセル VBA セルの結合 2 2022/09/07 11:48
- Visual Basic(VBA) エクセルVBAについて 2 2023/01/31 16:21
- Excel(エクセル) 条件に合った数値の合計を表示させたい関数と条件指定の方法 3 2023/05/13 16:07
- Excel(エクセル) Excelにの以下の設定方法について教えてください! C列にデータ入力の設定をしています。(出、入を 3 2022/06/22 01:33
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル: セルの枠を超えて表示
-
エクセルで画像を透過させて画...
-
Excel countif関数で取り消し線...
-
セル内の一部の文字だけをハイ...
-
エクセルで1つのセルにスクロ...
-
Excelでcsvやtxtで保存する時に...
-
VBA:結合されたセルに対する「...
-
エクセルのIF関数で、文字が...
-
エクセルのセル内の語句がはみ...
-
セルの大きさを個別に変更したい。
-
エクセルで右隣のセルより優先...
-
エクセルの白黒の反転で困って...
-
エクセルのコメントで自動サイ...
-
エクセルの入力規則プルダウン...
-
エクセルで特定の列のセルだけ...
-
エクセルで文字間隔・行間隔の...
-
エクセルで下が切れて印刷される
-
マウスポインターが白十字のまま
-
エクセルのセルの網かけ
-
エクセルで文字を打つと下に、...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル: セルの枠を超えて表示
-
Excel countif関数で取り消し線...
-
セル内の一部の文字だけをハイ...
-
エクセルの白黒の反転で困って...
-
セルは大きくさせず、中の文字...
-
マウスポインターが白十字のまま
-
エクセルファイルに _x000D_ と...
-
Excelでcsvやtxtで保存する時に...
-
エクセルで画像を透過させて画...
-
エクセルで1つのセルにスクロ...
-
エクセルでセルを上下に結合し...
-
エクセルの2つのセルを内容も消...
-
セルを結合しても、文字をセル...
-
エクセルで特定の列のセルだけ...
-
エクセルの入力規則プルダウン...
-
VBA:結合されたセルに対する「...
-
エクセルで右隣のセルより優先...
-
Excel入力で勝手にエンター押さ...
-
エクセル 折り返して全体を表...
-
エクセル2013で英単語を折り返...
おすすめ情報