『Visual Basic』に関する質問・疑問一覧

関連カテゴリ

次へ  ]
22009件中 1~20件目
  • 別のACCESSデータベースのテーブルのレコードを...

    別のACCESSデータベースのテーブルのレコードを追加したいのです 以前piroin654様にご指南頂き解決しましたが その後問題が発生しまして困っております http://okwave.jp/qa/q5995365.html レコードカウントで採番 rsInMain!番号 = rsInMain.RecordCount + 1 しておりましたが 1つのレコードを削除した場合、番号が重複してしまいます そこで rsInMain!番号 = rsInMain!番号の最終行の値+1にしたいのですが うまく行きません 何卒ご指南ください

    2010/09/09 03:03
  • エクセル(マクロ含む)で、列の並べ替えはできますか...

    エクセル(マクロ含む)で、列の並べ替えはできますか? 例えば、 A1  B1  C1  D1  E1 名前  ナシ  カキ  蜜柑  モモ 価格  80  50  45  95 人気   3   4   2   1 個数  35  90  80  20 という表において、 価格、人気、個数、それぞれの指標をもとに、 B1~E1までの列を、降順・昇順に並べ替えたりしたいのですが、 そんなことは可能でしょうか? 例えば、人気の指標で、降順に並べ替えるとすると、 E列(モモ列)がB列に来て、以下同様に、 D列(蜜柑列)がC列に、 B列(ナシ列)がC列に、 C列(カキ列)がE列に来るような形で、並べ替えが行われます。 並べ替えが行われるのは、あくまで、「列」において、です。 よく見かける「『行』が移動するような並べ替え」とは異なるものですので、 誤解無きよう、宜しくお願い致します。 以上、どなたか、お分かりになるかた、色々とお教示下さい。 必ず、お返事とポイント付与を行います。

    2010/05/07 21:43
  • Access vba 教えてください。 初心者です

    以下のような テーブルT_ソフトリスト、テーブルT_ソフト フォームF_入力 があったときに、フォームの使用者のコンボボックスに入力をしたときに、 T_ソフトから使用者を探して、ソフトリストIDを取得し、そのソフトリストIDを元にT_ソフトソフトのソフト名をフォームのコンボボックスに表示させるようにしたいのですが、 どの様なソースコードを書けばよいでしょうか? 「T_ソフトリスト」←テーブル ================================== ID  | ソフト名 | ────────────── 1   | A |  2  | B |  3  | C |  4  | D |  5  | E |  ================================== 「T_ソフト」←テーブル ================================== ID |ソフトリストID | 使用者 | ─────────────────── 1 |  4     | 佐藤  | 2 |  2     | 鈴木  | 3 |  5     | 斉藤  | 4 |  1     | 佐藤  | 5 |  3     | 田中  | ================================== 「F_入力」←フォーム ================================== 使用者  [コンボボックス]←Combo_UserType ソフト名 [コンボボックス]←Combo_User ==================================

    2011/01/25 21:55
  • VBAのデバックをどなたかお手伝いください。

    もちろん自分でも調べてはいるのですが、急いでいるため、もしどなたか教えてくだされば大変助かります。 この(下記の)Then 以降からがわかりません。 Do Until rs.EOF '該当レコードあり If rs!MCD = "3162" Then '--------------------------------------------- strcriteria = "CAT = '" & rs!CAT & "'" ' --- A rs2.Find strcriteria, 0, adSearchForward If rs2.EOF Then ' Else rs!仕入単価世代1 = rs!仕入単価 rs!仕入単価 = rs2!discount End If '--------------------------------------------- rs!更新日 = Now() rs.Update End If 情報が不足していればお答えします。どうぞ宜しくお願いいたします。 (補足)これより前に入力されているのは以下のものです。 Dim cn As ADODB.Connection Dim cn2 As ADODB.Connection Dim rs As ADODB.Recordset Dim rs2 As ADODB.Recordset Dim strmsg As String Dim lngRet As Long Dim strcriteria As String Set cn = CurrentProject.Connection Set rs = New ADODB.Recordset Set cn2 = CurrentProject.Connection Set rs2 = New ADODB.Recordset rs.Open "商品2_T", cn, adOpenKeyset, adLockOptimistic rs2.Open "商品2_T25discountてすと", cn2, adOpenKeyset, adLockOptimistic

    2010/12/07 09:51
  • VB2010 面積算出

    panelを用いた図形の作成を行っております。 コード Public Class Form1 Dim p1 As Integer 'Panel1のカウンター Dim p2 As Integer 'Panel2のカウンター Dim p3 As Integer 'Panel3のカウンター Dim p1size As Single 'Panel1の面積 Dim p2size As Single 'Panel2の面積 Dim p3size As Single 'Panel3の面積 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown Dim p1clnt As Drawing.Size = Panel1.ClientSize Dim p2clnt As Drawing.Size = Panel2.ClientSize Dim p3clnt As Drawing.Size = Panel3.ClientSize p1size = p1clnt.Width * p1clnt.Height p2size = p2clnt.Width * p2clnt.Height p3size = p3clnt.Width * p3clnt.Height Panel4.AllowDrop = True End Sub Private Sub Panel1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseDown, Panel2.MouseDown, Panel3.MouseDown sender.DoDragDrop(sender, DragDropEffects.Move) End Sub Private Sub Panel4_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Panel4.DragDrop Dim srsPnl As Panel = e.Data.GetData(GetType(Panel)) Dim dstPnl As New Panel dstPnl.Size = srsPnl.Size Dim dropp1 As Integer = srsPnl.Size.Width * srsPnl.Size.Height If dropp1 = p1size Then p1 += 1 ElseIf dropp1 = p2size Then p2 += 1 ElseIf dropp1 = p3size Then p3 += 1 End If dstPnl.Location = Panel4.PointToClient(CursorPosition) 'New Point(e.X, e.Y) dstPnl.BackColor = srsPnl.BackColor AddHandler dstPnl.MouseDown, AddressOf dstPnl_MouseDown AddHandler dstPnl.MouseMove, AddressOf dstPnl_MouseMove Panel4.Controls.Add(dstPnl) End Sub Private Sub Panel4_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles Panel4.DragEnter If e.Data.GetDataPresent(GetType(Panel)) Then e.Effect = DragDropEffects.Move End If End Sub Private previousPos As Point Private Sub dstPnl_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseDown previousPos = CursorPosition() End Sub Private Sub dstPnl_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then Dim nowPos As Point = CursorPosition() DirectCast(sender, Panel).Left += nowPos.X - previousPos.X DirectCast(sender, Panel).Top += nowPos.Y - previousPos.Y Console.WriteLine(nowPos.X & "-" & previousPos.X) previousPos = nowPos End If End Sub Function CursorPosition() As Point Return New Point(CInt(Cursor.Position.X / 10) * 10, CInt(Cursor.Position.Y / 10) * 10) End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim ans As Single ans = (p1 * p1size + p2 * p2size + p3 * p3size) * 0.0001 TextBox1.Text = ans End Sub End Class 上記のコードは、GroupBox内のpanelをpanel4へ移動させて図形を作成するものです。 移動させたpanelの数を数えて、全体の面積を算出させているのですが、 作成させた図形の右側1/4の面積だけ(左側1/4,下側1/4といった風に)の面積を算出させることは可能でしょうか? 画像 ※図形は任意  重複なし(panel同士) 1m2   (青) 3枚 0.25m2 (赤) 5枚 0.09m2 (黄) 5枚 計 4.7m2 となっています。 この作成した図形の緑色で着色した部分の面積を出したいと考えております。 もしお時間等ありましたら、お力添えをいただけると嬉しく思います。 どうかよろしくお願いします。

    2013/02/02 15:11
  • functionを含んだプログラムを作成したいので...

    functionを含んだ計算をプロシージャで行い、返すプログラムを作りたいのですが上手くいきません。 具体的には ある式に定められた値を代入(inputではなくEXCEL上に指定済み)し、 その定数の横にそれぞれ出力されるプログラムです。 function 内でforを用いた式を作成し、メインプログラムに出力する段階で、『引数は省略できません』と表示され起動することがありません。 一体なぜでしょうか? プログラムが間違っているだけでしょうが、治せません。

    2009/12/19 19:46
  • VBAでユーザーにフォルダを指定させたい

     Win2000でEXCEL97を使ってます。  ExcelVBAでダイアログボックスなどによりユーザーにフォルダを指定させたいのです。  ファイルを指定させるには、GetOpenFileNameメソッドを使えば出来ることは分かったのですが、フォルダを指定させるような方法が分からないのです。  本で読んだところでは、Excel2002ではFileDialogプロパティで可能なようなのですが、Excel97では出来ないようで…  97でも可能な方法があればご教授下さい。  よろしくお願いします。

    2003/06/23 00:07
  • VB6で、非表示モジュール(?)の表示方法

    他人様の作成したプログラムの改修をやることになりましたVB初心者です。 デザイン画面でコードを選択し、「定義」を右クリックすると 「'xxx' は非表示であるため、ここへはジャンプできません。」 と表示されます。 また、exe ファイルの実行時と比べて、プロジェクトウインドウに表示されるフォームやデザイナも少ないです。 これら非表示のモジュール(?)を表示するにはどのようにやればいいのでしょうか。 ご教示お願いいたします。 環境は Windows XP(SP3), Visual Basic 6.0 (SP6) です。

    2011/07/27 13:03
  • VisualBasicをはじめるにあたって。

    自宅でVisualBasicで開発勉強を行いたいと 思っていますが、開発をするにあたって 環境設定すると思うのですが、初心者にも わかるサイトをお分かりになる方よろしくお願い致します。

    2007/10/01 14:08
  • バイナリ→構造体

    http://oshiete1.goo.ne.jp/kotaeru.php3?q=1087139 の続きです。仕様の都合でMoveMemoryを使って構造体をファイルマッピングできないため、一度文字列にして…と考えていたんですが、どうも文字列にすると別な問題が出るようなのでLong型のポインタにしたいと思ってます。  何故Longかと言うとこれも仕様の都合なので…Byte配列にとは出来ないんですが…同じ、ですよね?  蛇足が長々と続きましたが、本題は… 1、VarPtrを使ってLong型のポインタに変換(してると思ってます) 2、それを別の構造体に格納、その構造体を共有メモリに移す。 3、別ウインドウから取り出し、最初のLongのポインタを引き抜く 4、Long型ポインタから構造体に戻す  となれば完成で、3までは進めるのですが…最後の4ができません。  ここから再び蛇足ですが、そもそも何故こんな面倒な事を?といいますと、共有メモリを扱うOCXを作る必要がありまして、さらに受け取ったデータをCue構造にしなければならないのです。その辺りを操作してるのが2つ目の構造体です。1と4はOCXを扱う側、2と3はOCX内で行ってます。  出来れば全部OCX内で出来るといいなーとは思ってますが…すいません、本当に蛇足でした。

    2004/11/17 11:23
  • 指定した日付が、その月の第何週かを求める方法

    月曜から日曜の作業内容を 書く報告書作成画面の作成をしています。 処理の一つに、 作成したい週の月曜の年月日を入力し、 日曜までの日付を自動的に画面に出す、 というものがあります。 さらに自動的に出した日曜日の日付から、 報告書作成週はその月の第何週かを求める、 (今月ですと10/6は第1週、10/13は第2週、 10/20は第3週、10/27は第4週、となります) という処理を作成したいのですが、 良いロジックが思い浮かびません。 (処理する月の日付と曜日を配列に入れて、 ループカウントで第何週かを求める、という 方法は思いついたのですが、効率が悪いと思うので…) 何か良いロジックがありましたら、 書き込みをお願い致します。

    2002/10/30 16:24
  • 「A」「B」「C」「D」のすべての語句があれば○

    下記のマクロは、「A」があったら○を付けるというものです。 「A」があったら・・・というのを、 「A」「B」「C」「D」のすべての語句があれば○、というようにしたいです。 それは、どのような記述に変更すればできるでしょうか? よろしくお願いいたします。 Sub main() '!!!! [Microsoft XML v6.0] に参照設定 Dim xHttp As IServerXMLHTTPRequest Dim myErr_Number As Long, myErr_Description As String Set xHttp = CreateObject("MSXML2.ServerXMLHTTP") Dim aCell As Range R = 1 For Each aCell In Selection.Columns(1).Cells Application.Goto aCell DoEvents sUrl = aCell.Value If sUrl <> "" Then xHttp.Open "GET", sUrl, True xHttp.setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS On Error Resume Next xHttp.send If xHttp.readyState <> 4 Then xHttp.waitForResponse 5 End If If xHttp.readyState <> 4 Then Err.Raise 1004, , myErr_Number = Err.Number myErr_Description = Err.Description On Error GoTo 0 If myErr_Number = 0 Then sHtml = xHttp.responseText nRtn = InStr(sHtml, "A") If nRtn = 0 Then aCell.Offset(, 1).Value = "--" Else aCell.Offset(, 1).Value = "○" End If Else aCell.Offset(, 1).Value = myErr_Description DoEvents End If Next Set xHttp = Nothing End Sub

    2019/07/12 17:15
  • VBA【dictionary勉強中ですが・・・】集...

    いつもお世話になっております。 現在dictionary勉強中ですが、なかなかコツをつかめず 思ったとおりのマクロを作成することができません(ノ_;) ところで、今回作成しているのは 元データ.xlsというファイルのシート(データ)に   |【A】| B | C |【D】| E | F |・・・|H|I|【J】|K 3  【顧客ID】|顧客|受付日|【担当】|・・・|【会場名】|(見出し) 4  データの始まり↓ と、ありまして、 集計データ.xlsのシート(集計)に  | A | B | C | D | E | F | 1 顧客ID|担当|会場名| と二行目から一覧表があります。 A列のIDが一致するものに Sheet(データ)  →  Sheet(集計)  セル( i, "D")の値 → セル( j, "B") に セル( i, "J")の値 → セル( j, "C")に     セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで(4回のみ) A列のIDが一致するものがない時 セル( i, "A")の値 → セル( 最終,"A")に  セル( i, "D")の値 → セル( 最終, "B") に セル( i, "J")の値 → セル( 最終,"C")に追加 というように、入れたいのですが、 以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。 Sub Try() Dim data_1() As String Dim data As Long Dim maxrow As Long Dim t As Integer, f As Integer, y As Integer Set ws1 = Worksheets("集計") Set ws2 = Worksheets("データ") Application.ScreenUpdating = False maxrow = ws2.Range("a65536").End(xlUp).Row With ws1 For i = 2 To Range("a65536").End(xlUp).Row data = .Cells(i, 1) f = 0 t = 0 With ws2 t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data) If t > 0 Then For n = 1 To maxrow ReDim Preserve data_1(f) If data = .Cells(n, 1) Then data_1(f) = .Cells(n, 10) f = f + 1 If t = f Then Exit For Else 'A列にIDが存在しなければ追加する:ここの記述がよく分かりません。 data_1(f) = .Cells(n, 1) End If Next n For y = 0 To UBound(data_1) ws1.Cells(i, maxcol(i)) = data_1(y) Next y End If End With Next i End With Application.ScreenUpdating = True End Sub '-------------------------- Private Function maxcol(ByVal i As Long) As Integer Dim j As Integer With Worksheets("集計") j = 4 Do While .Cells(i, j) <> "" j = j + 1 Loop maxcol = j End With End Function

    2008/07/11 00:38
  • 一定間隔のタスク処理について

    現在、一定期間のタスク処理について悩んでいます。 あるプログラムをタスクトレイに常駐させています。 このプログラムは、DBにアクセスするプログラムで、15分間隔でDBにアクセスしようとしています。 当初は、  1.タイマーイベントで処理する。  2.Windowsのタスクを使用する。 と考えていたのですが、  1.タイマーのインターバル(最大)は、約65000で    15分は設定できない。  2.タスクは、プログラムが常駐している為、初回    実行のみ行われる。(つまりずっとタスク実行中    となる。) という問題にぶつかってしまいました。 何か良い方法はないでしょうか? http://oshiete1.goo.ne.jp/kotaeru.php3?q=571156 なども参考にはしてみたのですが・・・ どうかよろしくお願い致します。

    2003/06/18 15:03
  • 続、VB 座標軸の回転?

    昨日 http://okwave.jp/qa/q7871613.html で質問したものです。 プログラムを作っていて上手に動かないので再度質問です。 xx = x0 - cx yy = y0 - cy x= xx * cosA - yy * sinA + cx y= xx * sinA + yy * cosA + cy x0 = x y0 = y xx:Xの中心からの相対座標 yy:Yの中心からの相対座標 x0:Xの現在地 y0:Yの現在地 cx:三角形の中心X cy:三角形の中心Y x:座標変換後のX y:座標変換後のY A:角度 このようにプログラムしたのですが、回転をさせると渦巻き状に広がってしまいます。 以下のようにプログラミングしたつもりなのですが、うまくいきません。 悪そうな部分を教えてくれるとありがたいです。 >> リーダーの座標を実座標を差し引いて原点(0,0)とし、メンバーの座標をリーダーからの相対座標(x1,y1)(x2,y2)・・・・とします 例えばメンバー(x1,y1)をリーダー中心に半時計周りへ10度回転させた場合の、移動先の座標を(xx1,yy1)とすると・・・ θ=10度(VBではラジアン単位へ変換してください) xx1=x1 * cosθ - y1 * sinθ yy1=x1 * sinθ + y1 * cosθ これで回転して移動した先xx1、yy1が求まります。 最初に差し引いた実座標を足して戻して完成です。

    2013/01/02 23:43
  • VB6 TextBoxの先頭が自動改行されてしまう

    中を見ていただき、ありがとうございます。 Visual Basic 6.0 をWinXP SP3で使って、メモを作っています。 機能としては非常に単純で、書き込み用のテキストボックス(以下Text1とします)と記録用のテキストボックス(つまりLocked=Trueとして書き込めないようにしている:以下Text2とします)があって、(1)Text1にメモを書いてEnterを押せば、(2)その内容がText2に転写され、(3)Text1の内容は消える、というものです。 ところが、以下のプログラムによってこれを実装しようとしたところ、Text1からText2への転写はうまくいくものの、2回目以降はText1の1行目が自動的に改行された状態になってしまい、必ず2行目から文章を打たなくてはいけないようになってしまいます。 Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then Text2.Text = Text2.Text & vbclrf & Text1.Text Text1.Text = "" End If End Sub 使用する上では特に問題無いのですが、見た目が少し悪いので、この1行目の「自動改行」をキャンセルする方法をご存知の方がいらっしゃいましたら、ご教授くださいますようお願い致します。

    2011/01/26 10:49
  • エクセルVBA 条件にあうときセルを塗りつぶすには...

    エクセルVBA 条件にあうときセルを塗りつぶすには? エクセルVBAについて教えてください。 _________A 列 _________B 列_________C列_________D列 -------------------------------------------- 1行| 基準値_________ 5_____________1____________8 2行| りんご____________1_____________9____________0 3行| みかん___________12___________5____________3 4行| ぶどう____________15___________7____________8 5行| バナナ____________3_____________1____________4 上図のようにデータがあります。 (実物は列行共に膨大です。また条件を4つ以上つける予定なので条件付書式は使えません) 各列の基準値に対して、セルの増減が、0以下のときに黄色に、5から8のとき大きくなるときに赤、9以上のときに青にセルの色を塗りつぶしたいです。 どのようにすればよいでしょうか? B列の場合、基準値が5です。 B2のセルの場合、基準値5と1(B2セル)の増減は-4です。 増減が0以下のときは黄色に、増減が5から8のときは赤に、増減が9以上のときに青にするので、このときは黄色に塗りつぶします。 B3のセルの場合、基準値5と12(B3セル)の増減は7です。 増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。 B4のセルの場合、基準値5と15(B4セル)の増減は10です。 増減が9以上のとき青色に塗りつぶすので、このセルは青色に塗りつぶします。 C2のセルの場合は、C列の基準値は1(C1セル)です。 基準値1と9(C2のセル)の増減は8です。 増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。 よろしくお願いいたします。

    2010/09/28 23:26
  • エクセルのVBAについて教えてください。

    以前に下記のような内容のプログラムを作成したいと投稿致しましたら dim row as Integer for row = 1 to 65535 if (selectSheet.Cells(1, row) = "") then selectSheet.Cells(1, row) = "#####" EndIf をアレンジしたいのです。 上記のプログラムが構築されているコマンドボタンと同じuserformにオプションボタンを5個、コンボボックスを一つ作りました。 オプションボタン1を選択するとコンボボックスにはあ行が。 オプションボタン2を選択するとコンボボックスにはか行が。 オプションボタン3を選択するとコンボボックスにはさ行が。 オプションボタン4を選択するとコンボボックスにはた行が。 オプションボタン5を選択するとコンボボックスにはな行が。 選択できるようにしたいのです。 次に選んだオプションボタンと同名前のシートに上記の#####が入力されるようにしたいのですが、どのようにすればいいのですか? このように教えて頂きました。 Public myop As Integer 'オプション選択保持用 Private Sub CommandButton1_Click() Dim row As Integer Dim mykey As String '比較キー '選択したオプションボタンにより '比較キーと選択保持用変数に各値を代入 Select Case True Case OptionButton1: mykey = "[あ-お]*": myop = 1 Case OptionButton2: mykey = "[か-こ]*": myop = 2 Case OptionButton3: mykey = "[さ-そ]*": myop = 3 Case OptionButton4: mykey = "[た-と]*": myop = 4 Case OptionButton5: mykey = "[な-ほ]*": myop = 5 Case Else: myop = 0 End Select If myop = 0 Then Exit Sub For row = 1 To 65535 If ActiveSheet.Cells(1, row).Value Like mykey Then ActiveSheet.Cells(1, row) = "#####" End If Next row End Sub これを流用して自分でいじりたいのですが、私が未熟ですので、コードの意味、役割がさっぱりわかりません。 わがままな質問ではございますが、どなたか上記のコードの意味を教えて頂けませんか? よろしくお願い致します。

    2010/01/29 22:47
  • iniファイルとの比較(iniファイル操作)

     初めまして私はVB6.0の初心者でVB6.0について勉強しています。現在以下のようなiniファイル操作について分からないことがあります。 ・プログラム内容 テキストボックスにログインID(例えばenshu)を入力しOKボタンを押して、iniファイル(例えばrenshu.ini)にある情報と照合してもしiniファイルに無かったら「ログインできません」というメッセージボックスを出すプログラム。 条件 ・フォームにテキストボックス(Text1.Text)とコマンドボタン(OKボタン)がある ・Iniファイルの形式(renshu.ini) IDNO(セクション名) OK_ID(キー名)1 = “enshu”(ログインID) OK_ID(キー名)2 = “ren”(ログインID) OK_ID(キー名)3 = “shu”(ログインID) 上のような形式が不特定多数ある ・Iniファイルの保存場所 c:\work\renshu.ini 私の場合以下のように書きました。 Private Sub OK_Click() 'OKボタンがクリックされたら If  Text1.Text <> GetIniString("IDNO", "OK_ID", "c:\work\renshu.ini") Then '入力したログインIDがiniファイルに無い場合 'メッセージ表示 MsgBox "ログインできません" End If End Sub としましたがメッセージボックスが表示されません。なぜなのでしょうか。教えてください。宜しくお願いいたします。

    2008/05/08 17:22
  • VBAコードでシート名を取得したい。

    下記のコードは、指定したExcelブックにある情報をVBAコードを設置したブックに 情報を取得するコードになります。 質問なんですが・・・指定したExcelブックは、予めSheet名までをVBAコードで指定し、 そのSheetの内容を取得していますが、この部分を指定したSheet名ではなく、 Sheet名を取得し、取得したSheet名から自分で選択したSheetを選んび、 そのSheetの内容を取得する様に変えたいと考えています。 取得する側のSheet名が一定の名前になっていない為、 今までSheet名を変えて情報を取得する様にしていたのを 変えずに情報を取得したいと思ったからなんですが・・・ どの様に変えればできるのか初心者のためよろしくお願いします。 できましたら・・・UserForm2を使ってComboboxに取得するSheet名を 一覧化し、そのComboboxからSheet名を選べる様にしたいと思います。 ----------------------------------------------------------------------------------- Public Day As String '全プロシージャーで有効な変数 Sub CommandButton1() If MsgBox(Space(6) & "メールデータを取込みます。よろしいですか?", vbYesNo, "継続確認") = 7 Then Exit Sub Dim LstWb As Workbook Dim LstWs As Worksheet Dim OutWs As Worksheet Dim LstDt As Variant Dim EndRow As Long Dim Day0 As String Dim Day1 As String Dim i As Long Dim j As Integer Dim k As Long Set LstWb = Workbooks.Open(ThisWorkbook.Path & "\テストファイル.xlsm") Set OutWs = ThisWorkbook.Sheets("Sheet1") Set LstWs = LstWb.Sheets("Sheet1") EndRow = LstWs.Cells(Rows.Count, 1).End(xlUp).Row With LstWs LstDt = .Range(.Cells(1, 1), .Cells(EndRow, 5)) End With LstWb.Close Set LstWb = Nothing Set LstWs = Nothing Load UserForm2 With UserForm2 Day0 = LstDt(2, 4) .ComboBox1.AddItem Day0 For i = 2 To EndRow With .ComboBox1 Day0 = .List(.ListCount - 1) Day1 = LstDt(i, 4) If Day0 <> Day1 Then .AddItem Day1 End If End With Next i .ComboBox1.Value = .ComboBox1.List(0) End With UserForm2.Show For i = 1 To 5 OutWs.Cells(1, i).Value = LstDt(1, i) Next i k = 2 For i = 2 To EndRow Day0 = LstDt(i, 4) If Day = Day0 Then For j = 1 To 5 OutWs.Cells(k, j).Value = LstDt(i, j) Next j k = k + 1 End If Next i Set OutWs = Nothing LstDt = Empty UserForm1.Show (vbModeless)End Sub

    2012/06/09 18:27

ピックアップ