• ベストアンサー

リストボックスのAdditemの文字列生成

リストボックスのAdditemで表示する内容を一覧にしたいと思い、文字列を生成してみたのですが、どうもきれいに揃いません。どうしてーーー？？？ Do Until rs.EOF (ここで一旦各変数を初期化します） str_co = rs("会社名") str_name = StrConv(rs("商品名"), vbWide) str_price = rs("価格") str_orderday = rs("注文日") str_slip = rs("伝票No.") If Len(rs("受取日")) > 0 Then str_catchday = rs("受取日") Else str_catchday = "" End If If Len(rs("入金日")) > 0 Then str_payday = rs("入金日") Else str_payday = "" End If If rs("返品フラグ") = 1 Then str_returnday = "無" Else str_returnday = "有" End If spc1 = String(7 - Len(str_co), " ") spc2 = String(50 - Len(str_name), " ") spc3 = String(12 - Len(str_price), " ") spc4 = String(15 - Len(str_orderday), " ") spc5 = String(20 - Len(str_slip), " ") spc6 = String(15 - Len(str_catchday), " ") spc7 = String(15 - Len(str_payday), " ") str_data = str_co & spc1 & str_price & spc3 & str_orderday & spc4 & _ str_slip & spc5 & str_catchday & spc6 & str_payday & spc7 & str_returnday .AddItem str_data

質問者が選んだベストアンサー

  • ベストアンサー
  • Vargas
  • ベストアンサー率45% (9/20)
回答No.5

質問のコーディングを見ると、str_nameとspc2がリストボックスに表示するデータ（str_data）に含まれていませんが、これはデバッグするためにとりあえず省いていると考えてよろしいでしょうか？ かなり前の記憶でちょっと、曖昧ですが、確かこの様に文字列を整列させる為にはＭＳゴシック等プロポーショナルでないフォントを選択しても、2バイト文字混在の場合はずれてしまい、結局、フォントをTerminalにした覚えがあります。Terminalはフォントサイズがかなり限定されてしまいますが、唯一綺麗に先頭が揃ったと思います。 カラムを意識したデータを表示させる場合はグリッドコントロール等を使用した方が良いかもしれませんね。

Kalen_F
質問者

お礼

ご返答、本当に有難う御座います！ お礼がまたまた遅くなってしまって、スミマセンでした。 回答頂いた、Terminalでフォントを指定してみたら、うまくキレイに列が揃いました！ 感激です！＼(^o^)／ 最初はスプレッドか何かで表示しようかとも思ったのですが、どうしてもリストボックスでチャレンジしてみたかったんです。。。。。 良い勉強になりました！

その他の回答 (4)

回答No.4

補足です。正しいバイト数を求めるには、 LenB(StrConv(文字列, vbFromUnicode)) とすればＯＫです。

Kalen_F
質問者

補足

先程の長い文字列のフィールドなんですが、下記になります。 str_name = StrConv(rs("商品名"), vbWide) ここのStrConvは必要ないので省いたんです。 LenB(StrConv(文字列, vbFromUnicode)) で得られたバイト数を一件ずつ調べたら、 26 10 14 79 62 でした。 このフィールドの後ろに入るべき式は、下記にてコーディングしたのですが、まだ私は何か見落としているんでしょうか？ spc2 = String(80 - LenB(StrConv(str_name, vbFromUnicode)), " ")

回答No.3

半／全角が混在している場合、ListboxのFontsizeによっては、正しく スペースを埋めていたとしてもずれてしまうことがあります。 また、 String(N - Len(???), " ") は間違っています。(半／全角混在を仮定)Len関数は文字数を返しますので、 "12"と"１２"でどちらも「2」が返されます。これだと正しくスペース埋め できません。そこでLenB関数を使ってバイト数を算出するわけですが、 Unicodeの関係で半角でも全角でも１文字２バイトになってしまいます。 その解決にはStrConv関数を使用します。(Helpを見てください) あと、"123456789０"というような文字列で10Byteとる場合の、最後の文字 の処理についても注意が必要です。("０"がまっぷたつになる)

Kalen_F
質問者

お礼

詳しいご返答、本当に有難うございます！(^^) 試してみたんですけど、どういう訳か、５件中、１～３件目の文字が沢山格納させているフィールドだけ、ズレてしまうんです。。。。(T_T)

  • hardy50
  • ベストアンサー率29% (221/746)
回答No.2

再び＃１です。 リストボックスのフォントプロパティ値で変更してください。 失礼しました。

Kalen_F
質問者

お礼

まとめてのお礼で、誠に申し訳ございません！！ 試したのですが、以前と同じでズレたままなんです。。。(T_T)

  • hardy50
  • ベストアンサー率29% (221/746)
回答No.1

フォント名が「ＭＳＰゴシック」等の"Ｐ"の付いたものになっていませんか？ Ｐのついたフォントを使うと文字数が同じでも文字幅が変わってしまいます。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 文字列の比較をしたい

    String str1 = "北海道" String str2 = "北海道" str1とstr2が同じ場合にある処理をしたい場合、比較のところの記述はどのように書けばよいのでしょうか。 単純に If str1 = str2 Then ～～～～～ Else 　　～～～～ End If でよいのでしょうか。 環境はVB.NETです。

  • データを一覧で表示する方法

    VB6.0ProfessionalEditionで、 Accessのデータを一覧表示するのを作っているんですが、どうも上手くいかないんです。 OLE_ListというExcelのシートに表示させたいんでFormLoad時に書いていってるんですが、どこがマズおんでしょう？ Dim OLE_List(5, 10) As String Dim rs_cnt As Integer Dim i As Integer （DAOでコネクトして、変数rsでレコードセットしてます） rs_cnt = rs.RecordCount If rs_cnt > 0 Then i = 0 For i = 0 To rs_cnt - 1 str_co = rs("通販会社") str_name = rs("商品名") str_price = rs("価格") str_orderday = rs("注文日") str_slip = rs("伝票No.") OLE_List(1, i) = str_co OLE_List(2, i) = str_name OLE_List(3, i) = str_price OLE_List(4, i) = str_orderday OLE_List(5, i) = str_slip Next End If

  • 文字列で渡された式

    質問です。 タイトルのままですが文字列で渡された式で 処理を決定させることはできるのでしょうか？ たとえば ============================ dim str as string = "10 > 5" if strの文字列判定 then msgbox("TRUE") else msgbox("FALSE") end if ============================

  • VBScriptである文字列に半角文字が含まれているかどうか調べる方法について

    VBScriptである文字列に半角文字が含まれているかどうか調べる方法について、ネットで調べてソースコードを拾ってきたのですが... IFの条件でなぜ全角、半角が判断できるか分かりません。教えてください。お願いします。 iLen = Len(str1) iLenByte = 0 '--- 文字列のバイト数 For i = 2 To iLen strField = Mid(str1, i, 1) iCode = Asc(strField) If iCode > 0 Then '--- 半角文字 Else '--- 全角文字 End If Next

  • コンボボックスの開いたリストを閉じるには

    コンボボックスのリストを開くのはComboBox1.DropDownでできますが、閉じるのはどういう風にやればいいでしょうか。 今ユーザーフォームで Private Sub Combobox1_Change() ComboBox1.Clear v = ComboBox1.Text For i = 1 To 300 c = Worksheets("Sheet1").Cells(i, "A") If v = Left(c, Len(v)) And Len(v) > 0 Then ComboBox1.AddItem c End If Next i ComboBox1.DropDown End Sub と言う風にしていますが、リストを開きっぱなしだと変な表示になってしまい、マウスクリックで一旦閉じてから開かないと変な表示になってしまうのです。 そこで一旦リストをマクロで閉じさせてから再び開きたいのですが、どうすればいいでしょうか。

  • 2010 ｅｘｃｅｌ　マクロ　記号の変化

    エラー発生で強制終了になってしまいます。2007年のｅｘｃｅｌで作成したものですが、2010だと強制終了になってしまいます。 内容は□をダブルクリックすると■になるように作っています。 記述は2003年からのマクロ記述なので、変化が必要なのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'セルをダブルクリックすると、・→○→△→×→・と変更する。 Dim S1 As String Dim S2 As String Dim S01 As String Dim S02 As String Dim S03 As String Dim S04 As String S1 = "□" S2 = "■" S01 = "・" S02 = "○" S03 = "△" S04 = "×" On Error GoTo ERR_12 sCheckXY S1, S2 sCheckX1234 S01, S02, S03, S04 sChangeXY S1, S2 Exit Sub ERR_12: End End Sub Sub sChangeXY(X As String, Y As String) '選択セルに□があれば■に変える Dim Str0 As String 'str1の左端 Dim Str1 As String 'strの右側更新 Dim Str2 As String 'strの左側更新 Dim Str20 As String 'strの左側一部保存 Dim L As Long Dim M As Long Dim N As Long Str1 = ActiveCell.Text L = Len(Str1) Debug.Print L If L = 0 Then End End If For N = 1 To L Debug.Print Str2 Str0 = Left(Str1, 1) If Str0 = X Or N = L Then If Str20 <> "" Then If N = L Then Str20 = Str20 + Str0 End If If MsgBox(Str20 & "　　はチェックしますか？", vbYesNo, "選択肢") = vbYes Then Str2 = Str2 + Replace(Str20, X, Y) Str20 = Str0 Else Str2 = Str2 + Replace(Str20, Y, X) Str20 = Str0 End If Else Str20 = Str0 End If Else Str20 = Str20 + Str0 End If Str1 = Right(Str1, L - N) Next N ActiveCell.Value = Str2 End Sub Sub sCheckXY(X As String, Y As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X Then ActiveCell.Value = Y End ElseIf ActiveCell.Text = Y Then ActiveCell.Value = X End End If End Sub Sub sCheckX1234(X1 As String, X2 As String, X3 As String, X4 As String) '選択セルがXならY,YならXにチェックをかえる If ActiveCell.Text = X1 Then ActiveCell.Value = X2 End ElseIf ActiveCell.Text = X2 Then ActiveCell.Value = X3 End ElseIf ActiveCell.Text = X3 Then ActiveCell.Value = X4 End ElseIf ActiveCell.Text = X4 Then ActiveCell.Value = X1 End End If End Sub

  • またまた　エクセルのユーザー定義で

    前回以下のようなコードを教えていただきましたが、この変換を複数列で使えるようにするにはどうしたらいいのでしょうか？ D,G,N,Q,X,AA,の列に効かせたいのですが。 Private Sub worksheet_change(ByVal Target As Range) If Intersect(Target, Columns(1)) Is Nothing Or Selection.Count <> 1 Then Exit Sub Dim str As String str = Target Application.EnableEvents = False If Target <> "" Then If Len(str) = 7 Then Target = Left(str, 5) & "A" & Mid(str, 6, 1) & "-" & Right(str, 1) Else Target = Left(str, 5) & "A" & Mid(str, 6, 2) & "-" & Right(str, 1) End If End If Application.EnableEvents = True End Sub

  • Like演算子で、[と]を文字として扱い比較したい

    今、フォルダ内のファイルリストを作成するVBA(Excel2003)を作っています。そこで、ファイル（絶対パス：フルパス）に「含まれていい文字」と「含まれない文字」（キーワード）を指定できる機能を作っています。 以前、VB6で類似の機能を作った時は、すんなり行ったのですが、VBAではうまくいきません。正規表現が使えるに越したことはないのですが、「 [ や ] を文字として認識するだけでもいいです。」 リストを作るフォルダには、 　[20].txt 　テキスト[a]txt 　メモ[10] - コピー.txt などのテストファイルとその他ファイルが存在します。 キーワードを指定しないときには、うまく行きます。 指定すると、たとえば [10].txt というファイルがヒットしないように、NGワードを [10] を指定すると、[20].txtまでヒットしません。[a]では全てがヒットしません。 また、OKワードに[10]を指定すると[10]と[20]がヒットします。 ===== NGワードを比較している部分 ==== 引数：in_str が NGワード（スペースで区切って複数指定可能） 引数：target_Str がフルパス Public Function keywords_NG(in_Str As String, target_Str As String) As Boolean 　　If in_Str = "" Then 　　　　keywords_NG = True 　　　　Exit Function 　　End If 　　 　　Dim wordArray() As String 　　Erase wordArray() 　　wordArray() = Split(in_Str, Space(1)) 　 　　Dim tempFLG As Boolean 　　tempFLG = True 　　 　　Dim wordIDX As Long 　　For wordIDX = 0 To UBound(wordArray) Step 1 　　　　If wordArray(wordIDX) <> "" And target_Str <> "" Then 　　　　　　If target_Str Like "*" & wordArray(wordIDX) & "*" = True Then 　　　　　　　　tempFLG = False 　　　　　　End If 　　　　End If 　　Next 　　If tempFLG = True Then 　　　　keywords_NG = True 　　Else 　　　　keywords_NG = False 　　End If End Function ===== OKワードを比較している部分 ==== 引数：in_Str が OKワード（スペースで区切って複数指定可能） 引数：target_Str がフルパス Public Function keywords_OK(in_Str As String, target_Str As String) As Boolean 　　If in_Str = "" Then 　　　　keywords_OK = True 　　　　Exit Function 　　End If 　　Dim wordArray() As String 　　Erase wordArray() 　　wordArray() = Split(in_Str, Space(1)) 　　 　　Dim tempFLG As Boolean 　　tempFLG = False 　　 　　Dim wordIDX As Long 　　For wordIDX = 0 To UBound(wordArray) Step 1 　　　　If wordArray(wordIDX) <> "" And target_Str <> "" Then 　　　　　　If target_Str Like "*" & wordArray(wordIDX) & "*" = True Then 　　　　　　　　tempFLG = True 　　　　　　End If 　　　　End If 　　Next 　　 　　If tempFLG = True Then 　　　　keywords_OK = True 　　Else 　　　　keywords_OK = False 　　End If 　　 End Function ===== [や]を区切り文字ではなくする関数 ==== Public Function keywords_escape_sequence(keywordStr As String) As String 　　 　　If keywordStr = "" Then 　　　　keywords_escape_sequence = "" 　　　　Exit Function 　　End If 　　 　　Dim myIDX As Currency 　　Dim str_X As String 　　 　　str_X = "" 　　　　 　　For myIDX = 1 To Len(keywordStr) Step 1 　　　　If Mid(keywordStr, myIDX, 1) = "[" Then 　　　　　　str_X = str_X & "[[]" 　　　　ElseIf Mid(keywordStr, myIDX, 1) = "]" Then 　　　　　　str_X = str_X & "[]]" 　　　　Else 　　　　　　str_X = str_X & Mid(keywordStr, myIDX, 1) 　　　　End If 　　Next 　　 　　keywords_escape_sequence = str_X End Function ===================================================== 　　　　If keywords_OK(keywords_OK_Str, フルパス)) = True And _ 　　　　　　keywords_NG(keywords_NG_Str, フルパス)) = True Then 　　　　　　　　'ファイルリスト作成 　　　　end if ===================================================== 正規表現を使うためには…というページを見つけ参照設定に以下の項目にチェックを入れてみましたが、結果は変わらす □Microsoft VBScript Regular Expressions 5.5 ===== RegExp と CreateObject ==== 参照設定をできれば変更したくない場合は、RegExp と CreateObject を使えば良いとあるページに書いてありましたが、参照設定でもできなかったので、これだけは試してません。 ヒントだけでもお教えください。

  • Excel VBAの文字列と数値の分類

    txtファイルで取り込んだ2行にまたがっている数値・英文字・ひらがななどを、数値だけのtxtファイルとそれ以外のtxtファイルを別々に作成し、保存するプログラムを組みたいのですが、よく分かりません。 ちなみに、使っているOSとAPはWinXP、Excel2003です。 InputData.txtの内容 A34bFg7p0 あ 1ylut890 B45LK4L え Number.txtの完成形 34701890454 String.txtの完成形 AbFgp あ ylutBLKL え '変数の宣言 Dim myFile As String Dim CC As Integer Dim XX As Integer Dim WW As Variant Dim str As String Dim tempStr As String Dim B As String Dim C As String myFile = Dir("InputData.txt") 'ファイルの読み込み If myFile = "InputData.txt" Then Open myFile For Input As #1 Do While Not EOF(1) Input #1, myText Loop '書き込みファイルの作成 Open "Number.txt" For Output As #2 Open "String.txt" For Output As #3 '数字・文字列の分類 CC = Len(myFile) For XX = 1 To CC str = Mid(myFile, XX, 1) If str >= 0 And str <= 9 Then B = B & str Else C = C & str End If Next Print #2, B Print #3, C Close #1, #2, #3 'エラーメッセージの表示 Else MsgBox "ファイルは存在しません。" End If ここまでやっている状態です。よろしくお願いします。

  • ２つのリストボックスを使っての抽出

    ２つのリストボックスでの複数選択でのフィルタをかけたいと思い、色々試行錯誤でイカのようにやってみましたが、何も抽出されない状態になります。下は最初にやってみてエラーになりました。 顧客タイプがアルファベットで文字列なのですが、ダブルクォーテーションの付き方が問題だと思うのですが、なかなか思うようになりません。アドバイスお願いします。 また、見よう見まねで初めて書いたようなコードなので無駄も多いと思いますが、そこのあたりのアドバイスも頂けるとうれしいです。宜しくお願いします。 Dim ctl1 As Control Dim ctl2 As Control Dim abc As String Dim aaa As Long Dim bbb As Variant Dim ddd As Variant Dim quot As String Set ctl1 = Me!検索1 Set ctl2 = Me!検索2 abc = "[月] in (" aaa = Len(abc) If ctl1.ItemsSelected.Count = 0 Or ctl2.ItemsSelected.Count = 0 Then MsgBox "月か顧客タイプの選択がされていません！", , "エラー" Exit Sub End If For Each bbb In ctl1.ItemsSelected If Len(abc) > aaa Then abc = abc & "," End If abc = abc & ctl1.Column(0, bbb) Next bbb quot = Chr(34) abc = abc & ") and [顧客タイプ] in (" & quot For Each ddd In ctl2.ItemsSelected If Len(abc) > aaa Then abc = abc & "," End If abc = abc & ctl2.Column(0, ddd) Next ddd abc = abc & quot & ")" Me.Filter = abc Me.FilterOn = True 最初は以下のようにしてもやってみました。 Dim ctl1 As Control Dim ctl2 As Control Dim abc As String Dim def As String Dim aaa As Long Dim bbb As Variant Dim ccc As Long Dim ddd As Variant Dim quot As String Dim ad As String Set ctl1 = Me!検索1 Set ctl2 = Me!検索2 abc = "[月] in (" aaa = Len(abc) If ctl1.ItemsSelected.Count = 0 Or ctl2.ItemsSelected.Count = 0 Then MsgBox "月か顧客タイプの選択がされていません！", , "エラー" Exit Sub End If For Each bbb In ctl1.ItemsSelected If Len(abc) > aaa Then abc = abc & "," End If abc = abc & ctl1.Column(0, bbb) Next bbb abc = abc & ")" quot = Chr(34) def = "[顧客タイプ] in (" & quot ccc = Len(def) For Each ddd In ctl2.ItemsSelected If Len(def) > ccc Then def = def & "," End If def = def & ctl2.Column(0, ddd) Next ddd def = def & quot & ")" ad = abc And def Me.Filter = ad Me.FilterOn = True こちらは型が違う、とエラーになります。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する