Excel VBA質問箱 IV

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

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


9053 / 13646 ツリー ←次へ | 前へ→

【29162】任意の行のレコードをユーザフォームへ貼付け うくれれ 05/9/27(火) 0:01 質問[未読]
【29173】Re:任意の行のレコードをユーザフォームへ... Lion 05/9/27(火) 10:29 発言[未読]
【29220】Re:任意の行のレコードをユーザフォームへ... うくれれ 05/9/27(火) 21:54 お礼[未読]
【29221】Re:任意の行のレコードをユーザフォームへ... うくれれ 05/9/27(火) 22:23 質問[未読]
【29224】Re:任意の行のレコードをユーザフォーム... Lion 05/9/27(火) 23:53 発言[未読]
【29247】Re:任意の行のレコードをユーザフォーム... うくれれ 05/9/29(木) 1:36 質問[未読]
【29253】Re:任意の行のレコードをユーザフォーム... Lion 05/9/29(木) 10:23 発言[未読]
【29299】Re:任意の行のレコードをユーザフォーム... うくれれ 05/9/30(金) 1:49 質問[未読]
【29311】Re:任意の行のレコードをユーザフォーム... Lion 05/9/30(金) 12:12 発言[未読]
【29352】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/2(日) 2:00 質問[未読]
【29354】Re:任意の行のレコードをユーザフォーム... Lion 05/10/2(日) 18:33 発言[未読]
【29465】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/5(水) 22:47 お礼[未読]
【29477】Re:任意の行のレコードをユーザフォーム... LION 05/10/6(木) 0:50 発言[未読]
【29478】Re:任意の行のレコードをユーザフォーム... LION 05/10/6(木) 0:58 発言[未読]
【29639】Re:任意の行のレコードをユーザフォーム... うくれれ 05/10/10(月) 1:46 質問[未読]

【29162】任意の行のレコードをユーザフォームへ貼...
質問  うくれれ  - 05/9/27(火) 0:01 -

引用なし
パスワード
   こんばんは。
住所録のようなものを作っています。
シートの各行に氏名、住所、生年月日、性別・・・というデータを入力していくユーザフォームを作りました。
そこで、既に入力したデータを変更するマクロをユーザフォームで作成することを考えています。
ある任意の行を選択(行をクリックするなどして範囲指定)して、エクセル上のコマンドボタンから、その行に入力されているデータを入力用ユーザフォームのテキストボックスやチェックボックス、リストボックスに反映するようにし、さらにユーザフォーム上のコマンドボタンから、当該行に変更したデータを入力するようにしたいのですが、どのような方法があるのでしょうか。

エクセル初心者ですいません。
よろしくおねがいします。

【29173】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/9/27(火) 10:29 -

引用なし
パスワード
   うくれれ さん
はじめまして

住所録をユーザーホームのリストボックスに表示して
そこから、変更・削除してはどうでしょうか

下記のコードでリストボックスに住所録を表示できます
後は変更削除するTEXTBOXなどを配置して、そこから変更削除する。

シートの構成が分からないので
Sheet1のA列の1行目から見出しが
氏名、住所、生年月日、性別 とあるものとします。

だめなボツにして下さい。

リストボックス1のプロパティーの ColumnHeada を True に設定

Private Sub UserForm_Initialize()
Dim LASROW As Long
Dim myDRange As String

With ListBox1
  .ColumnCount = 4
  .ColumnWidths = "50;50;50;50"
End With

LASROW = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange = "Sheet1!A2:D" & LASROW
ListBox1.RowSource = myDRange

If Worksheets("Sheet1").Range("A2").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub

【29220】Re:任意の行のレコードをユーザフォーム...
お礼  うくれれ  - 05/9/27(火) 21:54 -

引用なし
パスワード
   ご回答いただきありがとうございます!!
さっそくためしてみます。

【29221】Re:任意の行のレコードをユーザフォーム...
質問  うくれれ  - 05/9/27(火) 22:23 -

引用なし
パスワード
   たびたびすいません。

>住所録をユーザーホームのリストボックスに表示して
>そこから、変更・削除してはどうでしょうか
>
>下記のコードでリストボックスに住所録を表示できます
>後は変更削除するTEXTBOXなどを配置して、そこから変更削除する。
>
>シートの構成が分からないので
>Sheet1のA列の1行目から見出しが
>氏名、住所、生年月日、性別 とあるものとします。
>
>だめなボツにして下さい。
>
>リストボックス1のプロパティーの ColumnHeada を True に設定
>
>Private Sub UserForm_Initialize()
>Dim LASROW As Long
>Dim myDRange As String
>
>With ListBox1
>  .ColumnCount = 4
>  .ColumnWidths = "50;50;50;50"
>End With
>
>LASROW = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
>myDRange = "Sheet1!A2:D" & LASROW
>ListBox1.RowSource = myDRange
>
>If Worksheets("Sheet1").Range("A2").Value = "" Then
>  ListBox1.RowSource = ""
>End If
>
>End Sub

以上のやり方でリストボックスに表示するところまではできましたが、その後選択した行の入力値を変更・削除するにはどのようにしたらよいのでしょうか。

ちなみに名簿のレイアウトは、

  A   B    C   D   E・・・・・CX
1 名前 登録番号  登録日 項目1 項目2    項目##
2 ・   ・    ・   ・   ・      ・
3 ・   ・    ・   ・   ・      ・

A,B,Cはテキスト、D以降は入力値がある場合に0と1であらわしています。
A,B,Cはテキストボックスから、D以降はチェックボックスから入力しています。

初心者ですみません。よろしくお願いします。

【29224】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/9/27(火) 23:53 -

引用なし
パスワード
   こんばんは

>  A   B    C   D   E・・・・・CX
>1 名前 登録番号  登録日 項目1 項目2    項目##
>2 ・   ・    ・   ・   ・      ・
>3 ・   ・    ・   ・   ・      ・
>
>A,B,Cはテキスト、D以降は入力値がある場合に0と1であらわしています。
>A,B,Cはテキストボックスから、D以降はチェックボックスから入力しています。

とのことですので
UserFormに
LISTBOX1とTEXTBOX1から3
CHECKBOC1から100を配置してください。
>入力しています
とのことですから、すでに配置できてると思いますが。

下記のコードを入力して下さい。
リストボックスをクリックして
各項目が表示されるか確認してください。


Private Sub UserForm_Initialize()
Dim LASROW1 As Long
Dim myDRange1 As String
Dim f As Long

With ListBox1
  .ColumnCount = 3
  .ColumnWidths = "80;80;50"
End With

LASROW1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange1 = "Sheet1!A2:C" & LASROW1
ListBox1.RowSource = myDRange1

If Worksheets("Sheet1").Range("A2").Value = "" Then
  ListBox1.RowSource = ""
End If

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = ""
Next
For f = 1 To 100
  Controls("CHECKBOX" & f).Value = False
Next
End Sub
'----------------------------------------------------------
Private Sub ListBox1_Click()
Dim f As Long
Dim myNAME As String
Dim myLID As Long

myNAME = ListBox1.Column(0)
myLID = ListBox1.ListIndex + 2

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = Worksheets("Sheet1").Cells(myLID, f).Value
Next

For f = 1 To 100
  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = 0 Then
    Controls("CHECKBOX" & f).Value = False
  End If
  
  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = 1 Then
    Controls("CHECKBOX" & f).Value = True
  End If

  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = "" Then
    Controls("CHECKBOX" & f).Value = False
  End If
Next
End Sub

【29247】Re:任意の行のレコードをユーザフォーム...
質問  うくれれ  - 05/9/29(木) 1:36 -

引用なし
パスワード
   ありがとうございます!!
教えていただいたやり方で、ユーザフォームに反映させることができました。
しかし、ユーザフォームからまたもとのセルに変更後のデータを反映させる所でまた
躓いてしまいました。
単純に、以下のように教えていただいたコードを=で挟んで逆にすればできるのかなと思ったのですが、これではまずいのでしょうか。

Private Sub 変更登録_Click()
Dim f As Long
Dim myNAME As String
Dim myLID As Long

myNAME = ListBox1.Column(0)
myLID = ListBox1.ListIndex + 4

For f = 1 To 4
  Cells(myLID, f + 1).Value = Controls("text" & f).Value
Next

Cells(myLID, 6).Value =combo1.Value
 
For f = 5 To 7
  Cells(myLID, f + 2).Value = Controls("text" & f).Value
Next

すみませんがよろしくお願いします。

【29253】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/9/29(木) 10:23 -

引用なし
パスワード
   うくれれ さん
おはようございます

>単純に、以下のように教えていただいたコードを=で挟んで逆にすればできるの
>かなと思ったのですが、これではまずいのでしょうか。

おしいです!

うくれれさんの意図していないところで
ListBox1_Clickが呼ばれているからです。

下記コードに変更してください。

'-----------------------------------
Option Explicit
Dim myCHE As Boolean
'-----------------------------------
Private Sub CommandButton1_Click()
'---変更---
Dim f As Long
Dim myLID As Long

myLID = ListBox1.ListIndex + 2
myCHE = True

For f = 1 To 3
  Worksheets("Sheet1").Cells(myLID, f).Value = Controls("TEXTBOX" & f).Value
Next

For f = 1 To 100
  If Controls("CHECKBOX" & f).Value = False Then
    Worksheets("Sheet1").Cells(myLID, f + 3).Value = 0
  End If
Next

For f = 1 To 100
  If Controls("CHECKBOX" & f).Value = True Then
    Worksheets("Sheet1").Cells(myLID, f + 3).Value = 1
  End If
Next

myCHE = False
End Sub
'-----------------------------------
Private Sub UserForm_Initialize()
'---フォーム設定---
Dim LASROW1 As Long
Dim myDRange1 As String
Dim f As Long

With ListBox1
  .ColumnCount = 3
  .ColumnWidths = "80;80;50"
End With

LASROW1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange1 = "Sheet1!A2:C" & LASROW1
ListBox1.RowSource = myDRange1

If Worksheets("Sheet1").Range("A2").Value = "" Then
  ListBox1.RowSource = ""
End If

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = ""
Next
For f = 1 To 100
  Controls("CHECKBOX" & f).Value = False
Next
End Sub
'-----------------------------------
Private Sub ListBox1_Click()
'---リスト選択---
Dim f As Long
Dim myNAME As String
Dim myLID As Long

If myCHE = True Then
  Exit Sub
End If

myNAME = ListBox1.Column(0)
myLID = ListBox1.ListIndex + 2

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = Worksheets("Sheet1").Cells(myLID, f).Value
Next

For f = 1 To 100
  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = 0 Then
    Controls("CHECKBOX" & f).Value = False
  End If
  
  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = 1 Then
    Controls("CHECKBOX" & f).Value = True
  End If
  
  If Worksheets("Sheet1").Cells(myLID, f + 3).Value = "" Then
    Controls("CHECKBOX" & f).Value = False
  End If
Next

End Sub

'-----------------------------------

質問ですが
チェックボックスは100個無いのでしょうか?
私が思っていたのとシート構成も違うみたいですが
よろしいですか?

うくれれさんのシート構成に合わせてくださいね。

【29299】Re:任意の行のレコードをユーザフォーム...
質問  うくれれ  - 05/9/30(金) 1:49 -

引用なし
パスワード
   いつもありがとうございます!!!
おかげさまでできました。
ところでさらに質問ですが、教えていただいたユーザーフォームのリストボックスで選択した行をコマンドボタンから削除するにはどのようにするのでしょうか。

Private Sub コマンドクリア_Click()
'---削除---
Dim f As Long
Dim myLID As Long

myLID = ListBox1.ListIndex + 4
myCHE = True

Rows(myLID:myLID).Delete Shift:=xlUp

End Sub

上記のような感じでやってみたのですが、Rows・・・行で引っかかってしまいうまくできませんでした。
全然的外れなのかも知れませんが・・・。

ちなみにユーザフォームの構成は、以前質問した際と若干異なっています。
textbox1〜4、combobox1、textbox5、textbox6〜7、checkbox1〜6、textbox8、checkbox7〜15、textbox9・・・
という構成で、textbox6からtext9までの部分はマルチページで5ページ分同じ配列を繰り返しています。
それをエクセルシートに1行ずつA列からCX列まで順に貼り付けるようにしています。
現在作っているのは新規にデータを登録したり、変更、削除するというものです。

更には、オートフィルタでデータ抽出できるようにし、指定した行のデータを別シートに作成した「帳票」に貼り付けて印刷、というところまで作りたいと考えています。

【29311】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/9/30(金) 12:12 -

引用なし
パスワード
   こんにちは
うくれれさん
こんばんはかな?

登録・変更・削除の
下記コードを試してみてください。

ボタン等が複雑そうなので、TextBox 1・2・3だけで作成しています。
TextBox等うくれれさんの環境に合わせて下さいね。

>myLID = ListBox1.ListIndex + 4
なので 3行目に見だし、4行目からデータとしています。
また見出しはA列からにしています。
たぶん、最後の列がCXになるのでB列から見出しがあるのだと思いますが・・・
B列から見出しがあるのなら、私が思っているボタン等の配置は合っていると思うのですが・・・

登録・変更・削除があるので
Private Sub S_LIST()


End Sub
を追加しました。

'----------------------------------
Option Explicit
Dim myCHE As Boolean
'----------------------------------
Private Sub UserForm_Initialize()
'-----フォーム初期設定-----
Dim f As Long

With ListBox1
  .ColumnCount = 3
  .ColumnWidths = "80;80;50"
End With

Call S_LIST   'リスト表示

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = ""
Next

End Sub
'----------------------------------
Private Sub ListBox1_Click()
'-----リスト選択-----
Dim f As Long
Dim myNAME As String
Dim myLID As Long

If myCHE = True Then
  Exit Sub
End If

myNAME = ListBox1.Column(0)
myLID = ListBox1.ListIndex + 4

For f = 1 To 3
  Controls("TEXTBOX" & f).Value = Worksheets("Sheet1").Cells(myLID, f).Value
Next

End Sub
'----------------------------------
Private Sub S_LIST()
'-----リスト表示-----
Dim LASROW1 As Long
Dim myDRange1 As String

LASROW1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange1 = "Sheet1!A4:C" & LASROW1
ListBox1.RowSource = myDRange1

If Worksheets("Sheet1").Range("A4").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub
'----------------------------------
Private Sub CommandButton1_Click()
'-----変更----
Dim f As Long
Dim myLID As Long

'MsgBoxは必要なければ削除してください。
If MsgBox("変更しますか? ", vbYesNo, "うくれれ") <> vbYes Then
  Exit Sub
End If

myLID = ListBox1.ListIndex + 4
myCHE = True

For f = 1 To 3
  Worksheets("Sheet1").Cells(myLID, f).Value = Controls("TEXTBOX" & f).Value
Next

myCHE = False

End Sub
'----------------------------------
Private Sub CommandButton2_Click()
'-----リスト削除-----
Dim myLID As Long
Dim f As Long

'-リストを選択していないと終了
'MsgBoxは必要なければ削除してください。
If ListBox1.ListIndex = -1 Then
  'MsgBox "削除するリストを選択して下さい。 ", vbOKOnly, "うくれれ"
  Exit Sub
End If

'-削除するかの確認メッセージです。必要なければ削除してください。
'-有ったほうが安全のような気がしますが。
If MsgBox("削除しますか? ", vbYesNo, "うくれれ") <> vbYes Then
  Exit Sub
End If

myLID = ListBox1.ListIndex + 4

With Worksheets("Sheet1")
  .Range("A" & CStr(myLID), .Range("C" & CStr(myLID))).Delete Shift:=xlUp
End With

Call S_LIST 'リスト表示

End Sub
'----------------------------------
Private Sub CommandButton3_Click()
'-----登録-----
Dim myTAR As Range
Dim f As Long

'MsgBoxは必要なければ削除してください。
If MsgBox("登録しますか? ", vbYesNo, "うくれれ") <> vbYes Then
  Exit Sub
End If

Set myTAR = Worksheets("Sheet1").Range("A65536").End(xlUp)

With myTAR
  For f = 1 To 3
    .Offset(1, f - 1).Value = Controls("TEXTBOX" & f).Value
  Next
End With

Set myTAR = Nothing

Call S_LIST 'リスト表示

End Sub
'----------------------------------
>更には、オートフィルタでデータ抽出できるようにし、
>指定した行のデータを別シートに作成した「帳票」に貼り付けて印刷、
>というところまで作りたいと考えています。

方法は別として可能だと思います。
私に分かる範囲ならお答えできると思います。
分からない時はごめんなさい・・・

【29352】Re:任意の行のレコードをユーザフォーム...
質問  うくれれ  - 05/10/2(日) 2:00 -

引用なし
パスワード
   Lionさんありがとうございます。
お礼が遅れてしまいすみません。
おかげさまで考えていたとおりのものが出来ました!!!
ありがとうございました!

VBAのVも知らない私でいつもたよりきりで申し訳ないのですが・・・。
前回書いたオートフィルタについての質問です。
今までに作成したデータベースから特定のテキスト又は数字を含む行を抽出したいと考えています。
「データベースの配列」
No. 氏名 登録番号1 登録番号2 登録日  発効日  登録型  
1 XXXX  9999   9999   171001  171002  A-1   
2  ・   ・    ・     ・    ・    ・
3  ・   ・    ・     ・    ・    ・

そこで、抽出用にユーザフォームを作り上記データベースの各列に対応するテキストボックス又はリストボックスを配置し、条件(複数指定可)を入力してコマンドボタンクリックでフィルタをかける、なんていうことは可能でしょうか。
例えば、登録日が170901で登録型がB-2の行をすべて抽出して表示したり、氏名XXXXの入力された行を抽出して表示する、というように・・・。

よろしくおねがいします!!

【29354】Re:任意の行のレコードをユーザフォーム...
発言  Lion  - 05/10/2(日) 18:33 -

引用なし
パスワード
   うくれれ さん
こんばんは
少し長いですが、がんばって下さい。

>「データベースの配列」
>No. 氏名 登録番号1 登録番号2 登録日  発効日  登録型  
>1 XXXX  9999   9999   171001  171002  A-1   
>2  ・   ・    ・     ・    ・    ・
>3  ・   ・    ・     ・    ・    ・
>
>そこで、抽出用にユーザフォームを作り上記データベースの各列に対応するテキストボックス又はリストボックスを配置し、条件(複数指定可)を入力してコマンドボタンクリックでフィルタをかける、なんていうことは可能でしょうか。
>例えば、登録日が170901で登録型がB-2の行をすべて抽出して表示したり、氏名>XXXXの入力された行を抽出して表示する、というように・・・。

下記の準備をして下さい。

UserForm
1)TEXTBOX 1〜7
2) LISTBOX1
3)COMMANDBUTTON 1,2

TEXTBOX1--No
TEXTBOX2--氏名
TEXTBOX3--登録番号1
TEXTBOX4--登録番号2
TEXTBOX5--登録日
TEXTBOX6--発効日
TEXTBOX7--登録番号登録型
COMMANDBUTTON1--検索ボタン
COMMANDBUTTON2--リスト全表示ボタン
に対応しています。

シート構成
作業 というシートを追加して下さい。
Sheet1の3行目A列〜G列まで下記の見出しがあるものとします。
No・氏名・登録番号1・登録番号2・登録日・発効日・登録型
Noは必ず入力されているものとします。

作業というシートは何もしなくていいです。
もし検索できなかったら作業というシートのセルの書式を全部文字列にして下さい。

下記のコードを入力またはコピーして下さい。
各TEXTBOXに検索する文字を入力して検索ボタンクリックして下さい。
検索結果がLISTBOXに表示されます。
リスト全表示ボタンをクリックすると全リストが表示されます。
確認してみて下さい。

確認後、UserForm・シートは、うくれれさんの環境に合わせて下さいね。

'---------------------------------------
Option Explicit
'---------------------------------------
Private Sub CommandButton1_Click()
'-----検索-----
Dim mySHI As Worksheet '作業シート
Dim myRhani As Range '抽出元範囲
Dim myRjouken As Range '抽出条件範囲
Dim myK1 As String 'TEXTBOX1
Dim myK2 As String 'TEXTBOX2
Dim myK3 As String 'TEXTBOX3
Dim myK4 As String 'TEXTBOX4
Dim myK5 As String 'TEXTBOX5
Dim myK6 As String 'TEXTBOX6
Dim myK7 As String 'TEXTBOX7
Dim LASROW As Long '最後のセル
Dim myDRange As String 'リスト表示範囲

ListBox1.ListIndex = -1

myK1 = TextBox1.Value 'No
myK2 = TextBox2.Value '氏名
myK3 = TextBox3.Value '登録番号1
myK4 = TextBox4.Value ' '登録番号2
myK5 = TextBox5.Value '登録日
myK6 = TextBox6.Value '発効日
myK7 = TextBox7.Value '登録型

Set mySHI = Worksheets("作業")
mySHI.Cells.Clear

With Worksheets("Sheet1")
  Set myRhani = .Range(.Range("A3"), .Range("A65536").End(xlUp).Offset(0, 6)) '抽出元範囲
  Set myRjouken = mySHI.Range("A1:G2")                '抽出条件範囲
  '抽出条件をセル範囲上に入力する
  mySHI.Range("A1").Value = .Range("A3").Value 'No フィールドを指定"
  mySHI.Range("B1").Value = .Range("B3").Value '氏名 フィールドを指定"
  mySHI.Range("C1").Value = .Range("C3").Value '登録番号1 フィールドを指定"
  mySHI.Range("D1").Value = .Range("D3").Value '登録番号2 フィールドを指定"
  mySHI.Range("E1").Value = .Range("E3").Value '登録日 フィールドを指定"
  mySHI.Range("F1").Value = .Range("F3").Value '発効日 フィールドを指定"
  mySHI.Range("G1").Value = .Range("G3").Value '登録型 フィールドを指定"
End With

With mySHI
  If TextBox1.Value = "" Then
    .Range("A2").Value = myK1 '抽出条件を指定
    Else
    .Range("A2").Value = "'=" & myK1 '抽出条件を指定
  End If
  
  If TextBox2.Value = "" Then
    .Range("B2").Value = myK2 '抽出条件を指定
    Else
    .Range("B2").Value = "'=" & myK2 '抽出条件を指定
  End If

  If TextBox3.Value = "" Then
    .Range("C2").Value = myK3 '抽出条件を指定
    Else
    .Range("C2").Value = "'=" & myK3 '抽出条件を指定
  End If

  If TextBox4.Value = "" Then
    .Range("D2").Value = myK4 '抽出条件を指定
    Else
    .Range("D2").Value = "'=" & myK4 '抽出条件を指定
  End If

  If TextBox5.Value = "" Then
    .Range("E2").Value = myK5 '抽出条件を指定
    Else
    .Range("E2").Value = "'=" & myK5 '抽出条件を指定
  End If

  If TextBox6.Value = "" Then
    .Range("F2").Value = myK6 '抽出条件を指定
    Else
    .Range("F2").Value = "'=" & myK6 '抽出条件を指定
  End If

  If TextBox7.Value = "" Then
    .Range("G2").Value = myK7 '抽出条件を指定
    Else
    .Range("G2").Value = "'=" & myK7 '抽出条件を指定
  End If
End With

'検索-検索結果を作業シートにコピー
  myRhani.AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=myRjouken, _
      copytorange:=Worksheets("作業").Range("A5")

'検索結果をリスト表示
LASROW = Worksheets("作業").Range("A65536").End(xlUp).Row
myDRange = "作業!A6:G" & LASROW
ListBox1.RowSource = myDRange

If Worksheets("作業").Range("A6").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub

'---------------------------------------
Private Sub CommandButton2_Click()
'-----リスト全表示-----
Dim f As Long

ListBox1.ListIndex = -1
Worksheets("作業").Cells.Clear

For f = 1 To 7
  Controls("TEXTBOX" & f).Value = ""
Next

Call S_LIST '初期リスト表示

End Sub

'---------------------------------------
Private Sub UserForm_Initialize()
'-----USERFORM初期設定-----
Dim LASROW As Long
Dim mySHI As Worksheet
Dim f As Long

With ListBox1
  .ColumnCount = 7
  .ColumnWidths = "50;50;50;50;50;50;50"
End With

Call S_LIST '初期リスト表示

End Sub

'---------------------------------------
Private Sub S_LIST()
'-----初期リスト表示------
Dim LASROW As Long
Dim myDRange As String

LASROW = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
myDRange = "Sheet1!A4:G" & LASROW
ListBox1.RowSource = myDRange

If Worksheets("Sheet1").Range("B4").Value = "" Then
  ListBox1.RowSource = ""
End If

End Sub
'---------------------------------------

【29465】Re:任意の行のレコードをユーザフォーム...
お礼  うくれれ  - 05/10/5(水) 22:47 -

引用なし
パスワード
   LIONさん お礼が遅くなり申し訳ありません。
ど素人の私に親切に教えてくださりありがとうございます!!
さっそく試してみます。

ところで、リストボックスに表示する方法ですが、
その方法だと印刷する際、例えば複数のレコードを選択印刷したりすることも
可能でしょうか?

【29477】Re:任意の行のレコードをユーザフォーム...
発言  LION  - 05/10/6(木) 0:50 -

引用なし
パスワード
   うくれれ さん
こんばんは

>ところで、リストボックスに表示する方法ですが、
>その方法だと印刷する際、例えば複数のレコードを選択印刷したりすることも
>可能でしょうか?

可能だと思いますが
私の経験では、プリンター・PCの環境によっては、まれに
選択したリスト全てが印刷できないことがありました。

うくれれさんの管理できるプリンター・PCだけで印刷するのであれば問題ないと思いますが、
(一度にどれくらい印刷できるか、うくれれさんが確認できるので)
不特定多数の人が使用するのであれば問題が出るかもしれません。
うくれれさんが今、開発中のソフトの性質によると思います。

印刷用のシートをしっかり
コードはそんなに難しくないと思います。

【29478】Re:任意の行のレコードをユーザフォーム...
発言  LION  - 05/10/6(木) 0:58 -

引用なし
パスワード
   うくれれ さん
すいません
途中で送信してしまいました。

>印刷用のシートをしっかり
>コードはそんなに難しくないと思います。
印刷用のシートをしっかり作っていれば
コードはそんなに難しくないと思います。
私の分る範囲ならお答えできます。

でした。

【29639】Re:任意の行のレコードをユーザフォーム...
質問  うくれれ  - 05/10/10(月) 1:46 -

引用なし
パスワード
   >印刷用のシートをしっかり作っていれば
>コードはそんなに難しくないと思います。

いつもありがとうございます。
私の考えているものは次のようなものです。
ユーザフォームにリストボックスと「選択印刷」、「全件印刷」、「リスト一覧表印刷」の各ボタンを配置します(ユーザーフォームは前回教えていただいた抽出用ユーザフォームを使用)。
1.「選択印刷」を押すと、リストボックスから選択したレコード(複数選択も可)について、別シートの帳票に反映させ、印刷する。
2.「全件印刷」を押すと、リストボックスに表示中のレコード全てについて、別シートの帳票に反映させ、印刷する。
3.「リスト一覧表示印刷」を押すと、リストボックスに表示中のレコードについて別シートの一覧表(レコードの内容を羅列したもの)に反映して印刷。
というものです。

ちなみに帳票への反映については、レコードの各項目(100個位ある)に0又は1が入っており、1なら帳票のあるセル範囲を罫線で囲む、0ならそのまま、といった形での反映を考えています。

コードは難しくないとのことですが・・・(T_T)
よろしくおねがいします。

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