Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

251 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77421】Re:あるファイルの中身をシートごとにわ...

ウッシ - 15/9/29(火) 9:05 -


	引用なし

	パスワード

こんにちは

こんな感じでしょうか？

Sub test()
　　Dim f As Variant
　　Dim b As Workbook
　　Dim t As Workbook
　　Dim i As Long
　　Dim j As Long
　　Dim a As Areas
　　
　　f = Application.GetOpenFilename("読み込みファイル (*.*), *.*", , , , False)
　　If f = False Then Exit Sub
　　
　　Workbooks.OpenText Filename:= _
　　　　f, Origin:=932, _
　　　　StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
　　　　ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
　　　　Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array( _
　　　　3, 1)), TrailingMinusNumbers:=True
　　　　
　　Set b = ActiveWorkbook
　　Set t = ThisWorkbook
　　Set a = b.Worksheets(1).UsedRange.SpecialCells(xlCellTypeConstants).Areas
　　
　　j = 1
　　For i = 1 To a.Count
　　　　If a(i).Cells(1, 1) Like "No*" Then
　　　　　　If j < 7 Then
　　　　　　　　t.Worksheets("Sheet" & j).Range("A5").EntireRow.Resize(Rows.Count - 5).ClearContents
　　　　　　　　a(i).Offset(1).Copy t.Worksheets("Sheet" & j).Range("A5")
　　　　　　　　j = j + 1
　　　　　　ElseIf j = 7 Then
　　　　　　　　a(i).Offset(1).Copy t.Worksheets("Sheet" & j).Range("A" & Rows.Count).End(xlUp).Offset(1)
　　　　　　　　j = j + 1
　　　　　　Else
　　　　　　　　Exit For
　　　　　　End If
　　　　End If
　　Next
　　
　　b.Close False
　　
End Sub

・ツリー全体表示


	【77420】Re:あるファイルの中身をシートごとにわ...

カイト - 15/9/29(火) 8:41 -


	引用なし

	パスワード

こんにちは。
説明がわかりにくく、申し訳ありません。
拡張子が日付時間のタイムスタンプになっています。
例 aaabbb.201509280835

NoA,NoB,Count1の転記は必要ありません。
次の行の数字の組み合わせから改行までの数字の組み合わせをシートごとに記載したいです。

▼ウッシさん：
>こんにちは
>
>ファイル名:aaabbb.timestamp
>
>はどんなファイルですか？
>
>拡張子が「timestamp」のテキストファイルですか？
>
>NoA,NoB,Count1という部分も転記するのですか？
>
>
>▼カイトさん：
>>あるファイルの中身をシートごとにわけて入力するということを行いたいです。
>>シートごとに分けて入力する方法がわかりません。
>>,がある場合は区切って一セルごとに表示します。
>>
>>ファイル名:aaabbb.timestamp
>>
>>--------------ファイルの中身--------------
>>はじまり
>>
>>NoA,NoB,Count1
>>1010,1,360
>>432,3,254
>>・
>>・
>>2356,6,227
>>
>>
>>NoC,NoD,NoE,Count2
>>101,34,31,565
>>3432,33,5,254
>>・
>>・
>>564,4,5,462
>>
>>Next 3
>>
>>
>>NoAS,NoDS,NoFD,Count3
>>45,8,13,454
>>65,7,6,454
>>・
>>・
>>75,3,2,576
>>・
>>・
>>
>>
>>おわり
>>--------------ファイルの中身--------------
>>
>>このような形式のデータを
>>sheet1～7までに分けて入れたいです。
>>sheetは用意してあります、データが入っています。
>>sheet1～6はA5から最後までのデータを削除後、A5からデータを入れたいです。
>>sheet7は既に入っている最後のデータ行の次の行からデータを入れたいです。
>>
>>sheet1はNoA,NoB,Count1の次の行から改行まで
>>sheet2はNoC,NoD,NoE,Count2の次の行から改行まで
>>
>>Next 3（たまにこういういらない表記が途中にあります。はじまりとおわりもファイル内に書いてありますが、いらない表記です。）
>>
>>NoAS,NoDS,NoFD,Count3の次の行から改行まで
>>以降も似たような形式で書かれています。
>>一行の項目数は3または4となります。
>>
>>以上ですが、どなたかよろしくお願いいたします。

・ツリー全体表示


	【77419】Re:あるファイルの中身をシートごとにわ...

ウッシ - 15/9/29(火) 8:08 -


	引用なし

	パスワード

こんにちは

ファイル名:aaabbb.timestamp

はどんなファイルですか？

拡張子が「timestamp」のテキストファイルですか？

NoA,NoB,Count1という部分も転記するのですか？

▼カイトさん：
>あるファイルの中身をシートごとにわけて入力するということを行いたいです。
>シートごとに分けて入力する方法がわかりません。
>,がある場合は区切って一セルごとに表示します。
>
>ファイル名:aaabbb.timestamp
>
>--------------ファイルの中身--------------
>はじまり
>
>NoA,NoB,Count1
>1010,1,360
>432,3,254
>・
>・
>2356,6,227
>
>
>NoC,NoD,NoE,Count2
>101,34,31,565
>3432,33,5,254
>・
>・
>564,4,5,462
>
>Next 3
>
>
>NoAS,NoDS,NoFD,Count3
>45,8,13,454
>65,7,6,454
>・
>・
>75,3,2,576
>・
>・
>
>
>おわり
>--------------ファイルの中身--------------
>
>このような形式のデータを
>sheet1～7までに分けて入れたいです。
>sheetは用意してあります、データが入っています。
>sheet1～6はA5から最後までのデータを削除後、A5からデータを入れたいです。
>sheet7は既に入っている最後のデータ行の次の行からデータを入れたいです。
>
>sheet1はNoA,NoB,Count1の次の行から改行まで
>sheet2はNoC,NoD,NoE,Count2の次の行から改行まで
>
>Next 3（たまにこういういらない表記が途中にあります。はじまりとおわりもファイル内に書いてありますが、いらない表記です。）
>
>NoAS,NoDS,NoFD,Count3の次の行から改行まで
>以降も似たような形式で書かれています。
>一行の項目数は3または4となります。
>
>以上ですが、どなたかよろしくお願いいたします。

・ツリー全体表示


	【77418】あるファイルの中身をシートごとにわけて...

カイト - 15/9/29(火) 0:06 -


	引用なし

	パスワード

あるファイルの中身をシートごとにわけて入力するということを行いたいです。
シートごとに分けて入力する方法がわかりません。
,がある場合は区切って一セルごとに表示します。

ファイル名:aaabbb.timestamp

--------------ファイルの中身--------------
はじまり

NoA,NoB,Count1
1010,1,360
432,3,254
・
・
2356,6,227

NoC,NoD,NoE,Count2
101,34,31,565
3432,33,5,254
・
・
564,4,5,462

Next 3

NoAS,NoDS,NoFD,Count3
45,8,13,454
65,7,6,454
・
・
75,3,2,576
・
・

おわり
--------------ファイルの中身--------------

このような形式のデータを
sheet1～7までに分けて入れたいです。
sheetは用意してあります、データが入っています。
sheet1～6はA5から最後までのデータを削除後、A5からデータを入れたいです。
sheet7は既に入っている最後のデータ行の次の行からデータを入れたいです。

sheet1はNoA,NoB,Count1の次の行から改行まで
sheet2はNoC,NoD,NoE,Count2の次の行から改行まで

Next 3（たまにこういういらない表記が途中にあります。はじまりとおわりもファイル内に書いてありますが、いらない表記です。）

NoAS,NoDS,NoFD,Count3の次の行から改行まで
以降も似たような形式で書かれています。
一行の項目数は3または4となります。

以上ですが、どなたかよろしくお願いいたします。

・ツリー全体表示


	【77417】Re:繰り返し　コピーペースト

β - 15/9/25(金) 16:52 -


	引用なし

	パスワード

▼YUKI さん：

一例です。

Sub Test()
　　Dim r As Range
　　Dim col As Range
　　Dim pos As Range
　　
　　Application.ScreenUpdating = False
　　
　　Set r = Range("F4:AB120")
　　
　　For Each col In r.Columns
　　　　If pos Is Nothing Then
　　　　　　Set pos = Range("Ac4")
　　　　End If
　　　　pos.Resize(r.Rows.Count).Value = col.Value
　　　　Set pos = pos.Offset(r.Rows.Count)
　　Next
　　
End Sub

・ツリー全体表示


	【77416】繰り返し　コピーペースト

YUKI - 15/9/25(金) 14:44 -


	引用なし

	パスワード

はじめまして、よろしくお願いします。
F～AB列の4～120行までのデータをAC列にまとめて表示したいです。
今までは全列コピーペーストのコードをやっていましたが
繰り返しコードで見やすく書き直したいです。

Range("F4:F120").Copy
　　Range("AC65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
　　Range("G4:G120").Copy
　　Range("AC65536").End(xlUp).Offset(1, 0).PasteSpecial
・・・・

色々なサイトを調べて、見よう見まねで作成してみたら、
AC列も同じように横にずれていってしまいました・・・。
お手数お掛けしますがよろしくお願い致します

・ツリー全体表示


	【77415】Re:データ一覧から複数条件で対象の行を...

ichinose - 15/9/24(木) 6:58 -


	引用なし

	パスワード

▼さいさん：
>VBAでデータ一覧から下記の条件で該当する人物・人物が記載されているセル（Range型）を取得したいです。
>
>表には、<No.><属性><種族><攻撃範囲><モード><名前>が記載されています。
>すべての条件を指定すればひとつの行しか出てこないという前提です。

Excelの便利な機能の一つ、オートフィルタを使うと出来そうな事象だと思います。
マクロの記録やこの質問箱でAutoFilterで検索すれば、類似質問が見つかると思います。

他にも　フィルタオプションというこれまた便利な検索機能がありますから、
使い方を覚えて、それから　マクロの記録やこのサイトを検索することで、
VBAコードにするにはどうすればよいか　調べることが出来ます。

www.vbalab.sakura.ne.jp/vbaqa/c-board.cgi?cmd=ntr;tree=62674;id=excel

オートフィルタでの検索例↑

>イメージ
>Dim hoge As Range
>set hoge = Activesheet.<検索条件>
>のような形
近い形で検索結果を取得できるようなインターフェースを持ったプログラムを
作れば可能です。
うまく作れば、次に作成するプログラムでも同様な検索が必要な場合、その時には
呼び出すだけで良いようになります。

>自分で探すと、No.9の「○○○○○」セル：G12 が探せます。（画像が貼れないので申し訳ないです）

www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=73554;id=excel

データ例を↑のように掲載すれば、回答する人や後々この投稿を参考にしたい方にも
便利なスレッドになりますから、データの掲載は必要ですよ！！

・ツリー全体表示


	【77414】データ一覧から複数条件で対象の行を探す

さい - 15/9/23(水) 22:35 -


	引用なし

	パスワード

VBAでデータ一覧から下記の条件で該当する人物・人物が記載されているセル（Range型）を取得したいです。

表には、<No.><属性><種族><攻撃範囲><モード><名前>が記載されています。
すべての条件を指定すればひとつの行しか出てこないという前提です。

イメージ
Dim hoge As Range
set hoge = Activesheet.<検索条件>
のような形

こちらが取得している情報
・属性=火 As String
・種族=神 As String
・攻撃範囲=広範囲 As String
・モード=攻撃 As String

自分で探すと、No.9の「○○○○○」セル：G12 が探せます。（画像が貼れないので申し訳ないです）
これをプログラムでやらせたいです。
どのように検索をすればよいか教えて下さい。

・ツリー全体表示


	【77413】Re:オートフィルタ　繰り返し

はる - 15/9/17(木) 16:15 -


	引用なし

	パスワード

>　　　　Sheets("計画").Range("K:N").Copy
>　　　　.Range("E:H").PasteSpecial Paste:=xlPasteValues
>
>でコピーされたデータ部分の1～2行目、セルE1:H2は空白になっていますか？
>.Range("E3").CurrentRegionに影響があります。
空欄です。何かしら埋めておいたほうが良かったでしょうか

頂いたマクロで思うような結果が出ました！
ありがとうございます！！！！！！

・ツリー全体表示


	【77412】Re:オートフィルタ　繰り返し

ウッシ - 15/9/17(木) 15:38 -


	引用なし

	パスワード

こんにちは

　　　　Sheets("計画").Range("K:N").Copy
　　　　.Range("E:H").PasteSpecial Paste:=xlPasteValues

でコピーされたデータ部分の1～2行目、セルE1:H2は空白になっていますか？
.Range("E3").CurrentRegionに影響があります。

また、
Criteria1:=.Cells(10, i).Value
は
Criteria1:=.Cells(i, 10).Value
ですね。

Sub test()
　　Dim aSh As Worksheet
　　Dim i　 As Integer
　　
　　Set aSh = Sheets("マクロセット")
　　'#データ更新
　　With aSh
　　　　.Columns("E:J").Clear
　　　　Sheets("計画").Range("K:N").Copy
　　　　.Range("E:H").PasteSpecial Paste:=xlPasteValues
　　　　Sheets("Data Base").Range("AP4:AP100").Copy
　　　　.Range("J8").PasteSpecial Paste:=xlPasteValues
　　　　
　　　　.Range("E3:H3").AutoFilter

　　　　If ActiveWorkbook.Worksheets.Count < 8 Then Exit Sub
　　　　For i = 8 To ActiveWorkbook.Worksheets.Count
　　　　　　.Range("$E$3:$H$5000").AutoFilter _
　　　　　　　　Field:=4, Criteria1:=.Cells(i, 10).Value
　　　　　　.Range("E3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
　　　　　　Sheets(i).Range("B53").PasteSpecial Paste:=xlPasteValues
　　　　Next i
　　End With
　　
End Sub

・ツリー全体表示


	【77411】Re:オートフィルタ　繰り返し

はる - 15/9/17(木) 14:17 -


	引用なし

	パスワード

ActiveSheetは、Sheets("マクロセット")です。

Sheets("計画")及びSheets("DateBase")は、
別ブックやシートから数式でデータを集めています。
フィルターに関してだけなら無関係です。

オートフィルタのマクロ作成中に分りにくくなったので、
一旦Sheets("マクロセット")データに集約しました・・

エラー内容といいますか、
J列の内容でフィルターされておらず、
全データがシート（8）にコピーされてしまいます。

返答頂いたマクロも同じ現象です。

・ツリー全体表示


	【77410】Re:オートフィルタ　繰り返し

ウッシ - 15/9/17(木) 14:02 -


	引用なし

	パスワード

こんにちは

セル位置とシートが良く分かりません。

ActiveSheet名は？
Sheets("マクロセット")？

Sheets("計画")は無関係？

どこで、どんなエラーになるのでしょうか？

Sub test()
　　Dim aSh As Worksheet
　　Dim i　 As Integer
　　
　　Set aSh = ActiveSheet
　　'#データ更新
　　With aSh
　　　　.Columns("E:J").Clear
　　　　Sheets("計画").Range("K:N").Copy
　　　　Sheets("マクロセット").Range("E:H").PasteSpecial Paste:=xlPasteValues
　　　　Sheets("Data Base").Range("AP4:AP100").Copy
　　　　Sheets("マクロセット").Range("J8").PasteSpecial Paste:=xlPasteValues
　　　　
　　　　.Range("E3:H3").AutoFilter

　　　　If ActiveWorkbook.Worksheets.Count < 8 Then Exit Sub
　　　　For i = 8 To ActiveWorkbook.Worksheets.Count
　　　　　　.Range("$E$3:$H$5000").AutoFilter _
　　　　　　　　Field:=4, Criteria1:=.Cells(10, i).Value
　　　　　　.Range("E3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
　　　　　　Sheets(i).Range("B53").PasteSpecial Paste:=xlPasteValues
　　　　Next i
　　End With
　　
　　Sheets("マクロセット").Select
　
End Sub

ActiveSheetがSheets("マクロセット")ならもっと整理出来ます。

・ツリー全体表示


	【77409】オートフィルタ　繰り返し

はる - 15/9/17(木) 13:34 -


	引用なし

	パスワード

お初にお目にかかります。VBAの入り口をうろうろしている初心者です。
過去ログ等を参考にして自分で組んでみましたがエラーで動かないので
ご指摘お願い致します。

Sub Macro3()
'
'
’#データ更新
　　Columns("E:j").Clear
　　Sheets("計画").Range("K:N").Copy
　　Sheets("マクロセット").Range("E:H").PasteSpecial Paste:=xlPasteValues
　　Sheets("Data Base").Range("AP4:AP100").Copy
　　Sheets("マクロセット").Range("J8").PasteSpecial Paste:=xlPasteValues
'
　 Range("E3:H3").Select
　　Selection.AutoFilter
'　
　　Dim i As Integer
　　If ActiveWorkbook.Worksheets.Count < 8 Then Exit Sub
　　For i = 8 To ActiveWorkbook.Worksheets.Count
　　ActiveSheet.Range("$E$3:$H$5000").AutoFilter Field:=4, Criteria1:=Cells(10, i).Value
　　Range("E3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
　　Sheets(i).Range("B53").PasteSpecial Paste:=xlPasteValues
　　Next i
　　Sheets("マクロセット").Select
　　
End Sub

左から8シート目以降に枚数未定のシートが40~70枚ほどあります。
E:H列のデータを、シート名（Ｊ列に順に記載）を用いH列でフィルターを掛け、
その抽出データを各シートに貼り付けを行いたいです。

色々調べてみたのですが、どう修正すればいいのか見つけきれず。。
どうかよろしくお願い致します

・ツリー全体表示


	【77408】Re:１字消す

ﾄｷﾉﾊｼﾞﾒ - 15/9/11(金) 12:33 -


	引用なし

	パスワード

▼β さん：
お返事有難うございました。

何とかうまくできました。

今後とも宜しくお願い致します。

・ツリー全体表示


	【77407】Re:１字消す

β - 15/9/9(水) 17:07 -


	引用なし

	パスワード

▼ﾄｷﾉﾊｼﾞﾒさん：

文字化けが激しいのですが、特殊な文字で質問文を書いておられるのでしょうか？

もし、A1:T40 の範囲のセルにある　☆を（場所はどこでも）無条件に消したいなら
範囲を選んで、置換。置換前文字が　☆、置換後は空白のままにして実行。
これをマクロ記録。

やはり、文字列の最後にある☆だけを消したいなら、その範囲のセルをループで１つずつ
☆があるかどうか判定して、あれば消す。
この判定は　Right(その文字列,1) が　☆　かどうかをきいてやればいいですし、
消すのは、いろんな方法がありますが、簡単なのは Left(その文字列,Len(その文字列)-1) で置き換えるといったことでしょうかね。

・ツリー全体表示


	【77406】１字消す

ﾄｷﾉﾊｼﾞﾒ - 15/9/9(水) 16:52 -


	引用なし

	パスワード

いつもお世話になります。セルが２０・苅阿阿蕕い△辰ﾆ
それぞれにカタカナの名前があって、字数は３〜９文字ぐらいですが、それら
の名前の最後に☆印が付いているのですが、その☆印のみを消したいのですが
(例・・・ヤマモト☆)　　A1:T40　まで
なにを使えば良いのか教えて下さい。
宜しくおねがいいたします。

・ツリー全体表示


	【77404】Re:テキストボックスのスクロールバー

β - 15/9/9(水) 9:28 -


	引用なし

	パスワード

▼tomi さん：

なんの役にも立たないレスですけど。

おもいつきで、API の　GetScrollInfo　で情報取得が成功したら、あるいは
API の　SendMessage　でスクロールバーにメッセージを送り、成功したら
スクロールバーが表示されている、失敗したら表示されていないという制御が
できるかもと、トライしましたが、そもそもＶＢＡで扱うユーザーフォームでは
テキストボックスのハンドルが取得できないので（私の力量では）、
その思い付きを試すこともできません。
（試して思惑通りかどうかもわかりませんが）

・ツリー全体表示


	【77403】Re:テキストボックスのスクロールバー

tomi - 15/9/9(水) 7:51 -


	引用なし

	パスワード

▼β さん：
>▼tomi さん：
>▼tomi さん：
>おはようございます。
>
> 本件、悩ましいですよねぇ。
> 別掲示板のやり取りの中でもありましたけど、ネックは、現在の文字フォントの種類とサイズで
>現在の文字列がどれだけの長さ（桁数ではなく）なのか、エクセルが、その情報を我々にくれない
> ということです。
>しかも、今回の場合、【文字の高さ】つまり１行の高さとテキストボックスの高さを比較しなければ
> いけないという要素も含まれてしまいます。この１行の高さも、我々は情報として取得できません。
> （エクセルの意地悪？）
>
>これも、別板になりますが、文字列の長さに関して、
>ht p://www.excel.studio-kazu.jp/kw/20150908152533.html
>でも、質問者さんともども悩みました。結局、苦肉の策でお茶を濁しましたが。
>
>Changeイベントでの文字数の把握と、そのフォント情報から自動処理をしたいということは
>重々理解できますが、う～ん・・・
>
> しかも、実は、解は１つだけではないということがあります。
>たとえば文字数が２０文字だったとします。
>これをテキストボックスにすべて表示させたいという場合、
>
>・１行にして、小さなサイズで表示
>・２行にして、少し大きなサイズで表示
>・３行にして、もっと大きなサイズで表示
> 　　・
>　　・
>　　・
>
>無数に解があります。
>
>で、それらの解の中で、今度は、そのフォントで、テキストボックスには何行収まるか
> これを、その時の文字の高さで判断して、できるだけ下に余白行がない解を選択。
>
>でも、コメントしたように、この文字の高さが取得できません。（と思います）
>
>ご希望のスクロールバーが出現しているかどうかを把握できれば、Changeイベント内で
>大きなフォントから始めて、ぐるぐる、ループさせて、スクロールバーが消えたら
>そのフォントで決定　ということができるんですがねぇ。
>
>やはり（お好みではなかったようですけど）別掲示板でのWinArrowさんのリコメンド、
> 入力したものを自分で調整して見やすくするということしかないのではと思います。
β さん適切なアドバイスありがとうございます。確かに悩ましい問題で、
　出来るだけ先方（利用者）の便宜を図ってやりたい気持ちで投稿しました。
　スクロールバーの出現が取得できれば・・・・
　もう一度考えなおします。

・ツリー全体表示


	【77402】Re:テキストボックスのスクロールバー

β - 15/9/9(水) 7:16 -


	引用なし

	パスワード

▼tomi さん：
▼tomi さん：
おはようございます。

本件、悩ましいですよねぇ。
別掲示板のやり取りの中でもありましたけど、ネックは、現在の文字フォントの種類とサイズで
現在の文字列がどれだけの長さ（桁数ではなく）なのか、エクセルが、その情報を我々にくれない
ということです。
しかも、今回の場合、【文字の高さ】つまり１行の高さとテキストボックスの高さを比較しなければ
いけないという要素も含まれてしまいます。この１行の高さも、我々は情報として取得できません。
（エクセルの意地悪？）

これも、別板になりますが、文字列の長さに関して、
ht p://www.excel.studio-kazu.jp/kw/20150908152533.html
でも、質問者さんともども悩みました。結局、苦肉の策でお茶を濁しましたが。

Changeイベントでの文字数の把握と、そのフォント情報から自動処理をしたいということは
重々理解できますが、う～ん・・・

しかも、実は、解は１つだけではないということがあります。
たとえば文字数が２０文字だったとします。
これをテキストボックスにすべて表示させたいという場合、

・１行にして、小さなサイズで表示
・２行にして、少し大きなサイズで表示
・３行にして、もっと大きなサイズで表示
　　・
　　・
　　・

無数に解があります。

で、それらの解の中で、今度は、そのフォントで、テキストボックスには何行収まるか
これを、その時の文字の高さで判断して、できるだけ下に余白行がない解を選択。

でも、コメントしたように、この文字の高さが取得できません。（と思います）

ご希望のスクロールバーが出現しているかどうかを把握できれば、Changeイベント内で
大きなフォントから始めて、ぐるぐる、ループさせて、スクロールバーが消えたら
そのフォントで決定　ということができるんですがねぇ。

やはり（お好みではなかったようですけど）別掲示板でのWinArrowさんのリコメンド、
入力したものを自分で調整して見やすくするということしかないのではと思います。

・ツリー全体表示


	【77401】Re:テキストボックスのスクロールバー

tomi - 15/9/9(水) 5:05 -


	引用なし

	パスワード

▼マナさん：
>▼tomi さん：
>
>これも、期待するものと違うかもしれませんが、
>都度、一定のフォントサイズにして行数をカウントするのはだめですか
>
>Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
>　　With TextBox1
>　　　　.Font.Size = 14
>　　　　MsgBox .LineCount
>　　　　If .LineCount > 5 Then
>　　　　　　.Font.Size = 10
>　　　　Else
>　　　　　　.Font.Size = 14
>　　　　End If
>　　End With
>End Sub
マナさんありがとうございます。上記でテストをしましたが、行数だけではなかなか私の希望が出来ないことがわかりました。文字数を減らし場合（行数が減る場合）にはフォントを一つ上げるとかです。そしてbeforeUpdateでなく、できればchangeイベントで実行したいと思っています。
　以上　よろしくお願いします。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

251 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free