Excel VBA質問箱 IV

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

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


35817 / 76732 ←次へ | 前へ→

【46106】Re:ユーザーフォームのリストを検索→転記
発言  yasu  - 07/1/23(火) 2:51 -

引用なし
パスワード
   ▼かみちゃん さん:
いろいろお気遣いありがとうございます。
まず下記コードでListBox1の表示が42行目までしか表示しないのですが

Private Sub UserForm_Initialize()
 Dim ws As Worksheet

 Set ws = Workbooks("コード.xls").Sheets("Sheet1")
 With Range("A1", Cells(Rows.Count, 3).End(xlUp))
  Me.ListBox1.ColumnCount = .Columns.Count '★この辺だと思い
                        いろいろ試しましたが
                        結果は変わりませんでした 
  Me.ListBox1.ColumnWidths = "30 pt;50 pt;40 pt"
  ws.Activate '★
  Me.ListBox1.RowSource = .Address
  ThisWorkbook.Activate '★
 End With
End Sub
>>別々の起動サンプルが出されたものですから
>>別々起動がいいのかなと思いました ただダブルクリックで
>>起動させた場合起動しているとすればその都度MsgBoxで表示させても
>>うざいかなと思ったものでそういうお考えなのかなと考えました。
>
>それは、違います。
>まず、yasuさんご自身がコードを提示されていますし、いきなり、仕様どおり
>動くコードを提示しても、yasuさんご自身のためにならないと思いましたので
>それぞれのご質問用にあくまでSampleを提示させていただいています。
>
>まさか、動くコードを作って提示してくださいというわけではないですよね?

試行錯誤[46092]夜遅くまでやってみたのですが残念ながら・・・降参です。
ダメだったダメコード貼り付けておきます。

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim MyDate As Date
 Dim WB1 As Workbook
 Dim WB2 As Workbook
 Dim strFileName As String

 If 1 < Target.Count Then Exit Sub
    On Error Resume Next
 If Not Intersect(Target, Range("S8:S107")) Is Nothing Then
    Cancel = True
  UserForm1.Show vbModeless
 Else
  UserForm1.Hide
 End If
 
 If 1 < Target.Count Then Exit Sub
    On Error Resume Next
 If Not Intersect(Target, Range("R8:R107")) Is Nothing Then
    Cancel = True

 Set WB1 = ThisWorkbook
 strFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
 If strFileName <> "False" Then
  '画面遷移を抑止する
  Application.ScreenUpdating = False
  Set WB2 = Workbooks.Open(strFileName)
  WB1.Activate
  '画面遷移を再開する
  Application.ScreenUpdating = True
 End If
 MsgBox "現在開いているファイルは" & vbCrLf & _
     WB1.FullName & vbCrLf & _
     WB2.FullName
 WB2.Close '指定したファイルを閉じる
 End If


  UserForm3.Show vbModeless
 Else
  UserForm3.Hide
 End If

ダイアログがでて"コード.xls"迄いきましたが
UserForm3はショーしません。

それから今回は以前のテキスト.txtから
コード.xlsに変えたのですがこれを表示させるために

UserForm3を前回同様に
ListBox1 ★これが42行目までしか表示しない
これは上のプロシージャ起動でなく単独で
Sub UserForm()
  UserForm3.Show
End Sub
立ち上げで気がつきました。
次にテキストボックス1を1つ(検索値入力用)
同じく検索用コマンドボタン1つ(検索実行用)
同じくコンボボックス1を1つ(選択決定)→終了
作りました。

よく考えたら下記のPrivate Sub CommandButton1_Click()にあたる
コードが無くては検索できないなと思いました。単純に
コード.txt→コード.xlsに変えるだけではダメですよね!


Private Sub ComboBox1_Change()
  ActiveCell.Value = Left(ComboBox1.Value, 6)
  Unload Me
End Sub

Private Sub CommandButton1_Click()
  Dim FName As String
  FName = ThisWorkbook.Path + "C:\コード.txt"
  Const cnsFILENAME = "C:\コード.txt"
  Dim intFF As Integer
  Dim strREC As String
  Dim GYO As Long

  intFF = FreeFile
  Open cnsFILENAME For Input As #intFF
  GYO = 1
  Do Until EOF(intFF)
    Line Input #intFF, strREC
    If strREC Like "*" & Me.TextBox1.Value & "*" Then
      UserForm2.ComboBox1.AddItem strREC
    End If
  Loop
End Sub

Private Sub CommandButton2_Click()
  UserForm2.ComboBox1.Clear
End Sub


>MsgBoxがうっとしいと感じるのならば、消せばいいだけです。
>それこそ、あくまで確認用で、確認さえだきれば必要ではありません。
これも断念そこまでたどり着いていません

>>それができるのであれば(ダブルクリック起動)でMsgBoxなし
>>ただし初回は表示されたほうがいいかも 起動済みであれば
>>すぐにUserForm2.Show vbModelessをショーしたいのですが・・・
>
>[46092]のSampleコードは二重オープンを防ぐコードですので、そのコードを
>[46085]のコードのオープン部分に組み込めばできるようにしてあるつもりです
>が、どのようにしたらいいかわかりませんか?

かみちゃんさんごめんなさい断念!
>>出来ればダブルクリックでbookを開きたいでsuね
>
>あと一歩でできるのですが・・・
>修正点などの要点はすべて提示しています。
>あとは、どう組み込めばいいのかだと思います。
>
>あと一息がんばりましょう♪
私ももう少しと思っておりましたが
やはり基本がよく解らないので・・・(-_-;)
なんとか面倒見てくれませんか。
よろしくお願いします。

0 hits

【46028】ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:02 質問
【46030】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 17:15 発言
【46031】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:33 発言
【46037】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 18:43 発言
【46039】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 20:29 発言
【46043】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 20:46 発言
【46051】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 22:51 発言
【46052】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 23:12 発言
【46057】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 23:32 発言
【46058】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 0:09 発言
【46060】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 0:21 発言
【46061】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 7:15 発言
【46063】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 10:21 発言
【46064】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 11:35 発言
【46067】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:18 発言
【46070】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 13:01 発言
【46071】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 13:09 発言
【46066】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:04 発言
【46084】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 17:25 発言
【46085】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:06 発言
【46087】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:12 発言
【46088】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:23 発言
【46086】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:07 発言
【46090】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:45 発言
【46092】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 20:48 発言
【46098】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 21:48 発言
【46099】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:07 発言
【46100】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 22:44 発言
【46101】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:55 発言
【46106】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 2:51 発言
【46107】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 3:03 発言
【46109】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 7:33 発言
【46114】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 9:28 発言
【46117】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 11:09 回答
【46120】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 14:09 発言
【46121】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 14:42 発言
【46122】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 15:09 発言
【46124】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 16:51 回答
【46129】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 17:33 発言
【46133】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 20:22 発言
【46134】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 20:40 発言
【46139】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 3:58 発言
【46140】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 7:28 発言
【46157】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 20:44 発言
【46159】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 20:51 発言
【46168】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/25(木) 0:22 お礼

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