Excel VBA質問箱 IV

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

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


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

【66820】開いたExcelのシート・セルの情報取得 ANTON 10/10/8(金) 1:34 質問[未読]
【66822】Re:開いたExcelのシート・セルの情報取得 Hirofumi 10/10/8(金) 8:42 発言[未読]
【66832】Re:開いたExcelのシート・セルの情報取得 Hirofumi 10/10/8(金) 20:16 発言[未読]
【66833】Re:開いたExcelのシート・セルの情報取得 ANTON 10/10/9(土) 0:40 お礼[未読]

【66820】開いたExcelのシート・セルの情報取得
質問  ANTON  - 10/10/8(金) 1:34 -

引用なし
パスワード
   お世話になっております。

先日の件に関して、メッセージボックスからユーザーフォームに変えた所、
下記問題に突き当たり困っております。ご助力いただけたらと思いますm(_ _)m

やりたい事としましては、

1.マクロで他Excelを開きます。

2.1で開いたExcelファイルの中からユーザーが任意のシートを選びます。

3.2で選んだシート内の任意のセルを選びます。

4.2で選んだシートをマクロを実行中のExcelにコピーします。

5.コピーしたシートを任意のシート名に変更します。

6.ユーザーフォーム内の指定されたテキストボックスに開いたExcel名・選んだシート名・選択したセルの列と行を表示します。

という作業をしようと思っています。
今悩んでいる問題点と致しまして、開いたエクセルから6の情報を表示するというマクロを作成することです。

1でシートを開いた後、モードレスで新しいユーザーフォームを表示し3でユーザーフォーム内の必要情報を取得、新ユーザーフォームのコマンドボタンを押すことでコピーを実施し6へ、という風にした場合は




新しいユーザーフォーム.show

Msgbox "シートをコピーしました。"


テキストボックスへ値の入力


End sub

とすると、新しいユーザーフォームが開いたと同時にその後の処理であるMsgboxやテキストボックスへの値の入力までが同時に行われてしまいます。
モードレスを解除するとコマンドボタンを押すまで処理は実行されないのですが、そうすると2.3の処理が行えなくなってしまいます。。。

別の方法として、ユーザーフォームを使わないでInputBoxを使用してやろうとました。
そうしたら、セルの行や列の情報を得ることは出来てもシートのコピーやシート名などシートに関する処理で思ったとおりの結果を出すことが出来ませんでした。。。

シート名やセルの行や列の情報は別の処理で値を使用するので、変数として保存しなければなりません。


以上の経緯から
ユーザーフォームをモードレスで使用してもその後の処理を待機させる方法、あるいはInputBoxを使用してシート名やシートのコピーを実現する方法を模索中ですが良い案が浮かびません。。。
今、その作成したVBAのあるExcelファイルが手元になく、コードをかけなくて申し訳ないのですが ご助力いただけませんでしょうか。

【66822】Re:開いたExcelのシート・セルの情報取得
発言  Hirofumi  - 10/10/8(金) 8:42 -

引用なし
パスワード
   ▼ANTON さん:
>お世話になっております。
>
>先日の件に関して、メッセージボックスからユーザーフォームに変えた所、
>下記問題に突き当たり困っております。ご助力いただけたらと思いますm(_ _)m
>
>やりたい事としましては、
>
>1.マクロで他Excelを開きます。
>↓
>2.1で開いたExcelファイルの中からユーザーが任意のシートを選びます。
>↓
>3.2で選んだシート内の任意のセルを選びます。
>↓
>4.2で選んだシートをマクロを実行中のExcelにコピーします。
>↓
>5.コピーしたシートを任意のシート名に変更します。
>↓
>6.ユーザーフォーム内の指定されたテキストボックスに開いたExcel名・選んだシート名・選択したセルの列と行を表示します。
>
>という作業をしようと思っています。
>今悩んでいる問題点と致しまして、開いたエクセルから6の情報を表示するというマクロを作成することです。
>
>1でシートを開いた後、モードレスで新しいユーザーフォームを表示し3でユーザーフォーム内の必要情報を取得、新ユーザーフォームのコマンドボタンを押すことでコピーを実施し6へ、という風にした場合は
>
>・
>・
>・
>新しいユーザーフォーム.show
>
>Msgbox "シートをコピーしました。"
>・
>・
>テキストボックスへ値の入力
>・
>・
>End sub
>
>とすると、新しいユーザーフォームが開いたと同時にその後の処理であるMsgboxやテキストボックスへの値の入力までが同時に行われてしまいます。
>モードレスを解除するとコマンドボタンを押すまで処理は実行されないのですが、そうすると2.3の処理が行えなくなってしまいます。。。
>
>別の方法として、ユーザーフォームを使わないでInputBoxを使用してやろうとました。
>そうしたら、セルの行や列の情報を得ることは出来てもシートのコピーやシート名などシートに関する処理で思ったとおりの結果を出すことが出来ませんでした。。。
>
>シート名やセルの行や列の情報は別の処理で値を使用するので、変数として保存しなければなりません。
>
>
>以上の経緯から
>ユーザーフォームをモードレスで使用してもその後の処理を待機させる方法、あるいはInputBoxを使用してシート名やシートのコピーを実現する方法を模索中ですが良い案が浮かびません。。。
>今、その作成したVBAのあるExcelファイルが手元になく、コードをかけなくて申し訳ないのですが ご助力いただけませんでしょうか。


UserFormをモードレスで開いて、そこから別のUserFormを呼び出す様な面倒な事をしないで
1つのUserFormで全て行えば善いのでは?
UserForm上から別のBookを開く事も出来ますし
開いたBookのシート選択もComboBox等使用して出来ます
また、セル範囲もRefEdito?でコントロールで出来ると思いますよ

【66832】Re:開いたExcelのシート・セルの情報取得
発言  Hirofumi  - 10/10/8(金) 20:16 -

引用なし
パスワード
   例えば、以下の様なUserFormをモーダル表示で試して見たら?

UserFormに以下のコントロールを配置します
1、TextBox1:OpenしているBookのFullPathを表示
2、CommandButton1:OpenするBookを選択する為のダイアログ表示し、BookをOpen
3、CommandButton2:現在OpenしているBookをCloseする
4、ComboBox1:OpenしたBook(転記元)のシート選択
5、RefEdit1:転記元シートの範囲選択用
6、ComboBox2:マクロの在るBook(転記先)のシートを選択、若しくは新規シート作成
7、CommandButton3:転記実行ボタン
8、CommandButton4:UserFormを閉じるボタン

UzerFormが表示される時点で、TextBox1が""ならBook選択ダイアログが表示されるので
選択してOkすれば、BookがOpenされます
BookがOpenされると、そのBookの全シート名がComboBox1のListに設定されます
Copyするシートを選択し、RefEdit1にフォーカスが移れば、上記のシートで範囲選択が出来ます
次に、ComboBox2でList選択されればそのシートが転記先に選択され、
TextBox部に転記元に無いシート名を入れてEnterすれば、TextBox部の名前でシートが作成され転記先に成ります
RefEdit2は、転記先の転記位置を選択します
上記の各パラメタが揃えば、CommandButton3(実行ボタン)で転記が実行されます
CommandButton4は閉じるボタンで、もしBookが開いていた場合此れを閉じ、UserFormを閉じます

尚、RefEditのコントロールは、モードレスでは使えないと思います

Option Explicit

Private wkbOpen As Workbook

Private Sub UserForm_Activate()

  If wkbOpen Is Nothing Then
    CommandButton1_Click
  End If
  
End Sub

Private Sub UserForm_Initialize()

  Dim i As Long
  
  With ThisWorkbook
    For i = 1 To .Worksheets.Count
      ComboBox2.AddItem .Worksheets(i).Name
    Next i
  End With
  
  ComboBox1.Enabled = False
  RefEdit1.Enabled = False
  
End Sub

Private Sub UserForm_Terminate()

  Set wkbOpen = Nothing
  
End Sub

Private Sub ComboBox1_Change()

  If ComboBox1.ListIndex = -1 Then
    Exit Sub
  End If
  
  With wkbOpen.Worksheets(ComboBox1.Value)
    .Activate
    RefEdit1.Enabled = True
    RefEdit1.Value = .UsedRange.Address(External:=True)
    RefEdit1.SetFocus
  End With
    
End Sub

Private Sub ComboBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
  
  If ComboBox2.Value <> "" And ComboBox2.ListIndex = -1 Then
    If MsgBox("新規のシートをComboBoxの名前で作成します", vbOKCancel) = vbOK Then
      With ThisWorkbook.Worksheets.Add
        .Name = ComboBox2.Text
        .Activate
      End With
    Else
      Cancel = True
    End If
  Else
    If ComboBox2.ListIndex > -1 Then
      If MsgBox("既存のシートのデータを消去します", vbOKCancel) = vbOK Then
        With ThisWorkbook.Worksheets(ComboBox2.Text)
          .UsedRange.ClearContents
          .Activate
        End With
      Else
        Cancel = True
      End If
    End If
  End If
  
  RefEdit2.Enabled = True
  
End Sub

Private Sub ComboBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  With ComboBox2
    If .Value <> "" And .ListIndex = -1 Then
      .AddItem .Text
    End If
  End With
  
End Sub

Private Sub CommandButton1_Click()

  Dim i As Long
  Dim vntBook As Variant
  
  If Not GetReadFile(vntBook, ThisWorkbook.Path, False, "OpenするBookを選択して下さい") Then
    Exit Sub
  End If
  
  If StrComp(Dir(vntBook), ThisWorkbook.Name, vbTextCompare) = 0 Then
    MsgBox "開こうとしているBookはマクロの在るこのBookです"
    Exit Sub
  End If
  
  If wkbOpen Is Nothing Then
    TextBox1.Text = vntBook
    Set wkbOpen = Workbooks.Open(vntBook)
  Else
    If MsgBox("現在別のBookがOpenされていますのでCloseします", vbOKCancel) = vbOK Then
      wkbOpen.Close
      TextBox1.Text = vntBook
      Set wkbOpen = Workbooks.Open(vntBook)
    Else
      Exit Sub
    End If
  End If
  
  With ComboBox1
    .Text = ""
    .Clear
    For i = 1 To wkbOpen.Worksheets.Count
      .AddItem wkbOpen.Worksheets(i).Name
    Next i
  End With
  
  ComboBox1.Enabled = True
  RefEdit1.Enabled = False
    
End Sub

Private Sub CommandButton2_Click()

  If Not wkbOpen Is Nothing Then
    If MsgBox("現在のBookをCloseします", vbOKCancel) = vbOK Then
      wkbOpen.Close
      TextBox1.Text = ""
      Set wkbOpen = Nothing
    End If
  End If

  ComboBox1.Enabled = False
  RefEdit1.Enabled = False

End Sub

Private Sub CommandButton3_Click()

  Dim lngPos As Long
  Dim vntCopy As Variant
  Dim vntTo As Variant
  
  If ComboBox2.ListIndex > -1 Then
    vntCopy = RefEdit1.Value
    lngPos = InStr(1, vntCopy, "!", vbBinaryCompare)
    If lngPos > 0 Then
      vntCopy = Mid(vntCopy, lngPos + 1)
    End If
    vntTo = RefEdit2.Value
    lngPos = InStr(1, vntTo, "!", vbBinaryCompare)
    If lngPos > 0 Then
      vntTo = Mid(vntTo, lngPos + 1)
    End If
    wkbOpen.Worksheets(ComboBox1.Value).Range(vntCopy).Copy _
        Destination:=ThisWorkbook.Worksheets(ComboBox2.Text).Range(vntTo)
  End If

End Sub

Private Sub CommandButton4_Click()

  If Not wkbOpen Is Nothing Then
    wkbOpen.Close
  End If
  
  Unload Me
  
End Sub

Private Sub RefEdit2_Enter()
  
  If ComboBox2.ListIndex > -1 Then
    RefEdit2.Value = ThisWorkbook.Worksheets(ComboBox2.Text) _
                  .Cells(1, 1).Address(External:=True)
  End If
  
End Sub

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean = False, _
            Optional strTitle As String) As Boolean

'  FileDialog使用版

  Dim i As Long
  Dim objFDL As FileDialog
  Dim vntSelected As Variant
  Dim vntFilters As Variant
  
  'Filterを指定
  vntFilters = Array("Excel File", "*.xls;*.xlsx;*.xlsm")
  
  '[ファイル参照] ダイアログの FileDialog オブジェクトを作成
  Set objFDL = Application.FileDialog(msoFileDialogFilePicker)

  'Show メソッドでダイアログを表示し、ユーザーのアクションを取得
  With objFDL
    'タイトルを設定
    If strTitle <> "" Then
      .Title = strTitle
    End If
    '初期フォルダ及び、指定ファイル名を設定
    If strFilePath <> "" Then
      .InitialFileName = strFilePath
    End If
    'Filterを設置
    With .Filters
      .Clear
      For i = 0 To UBound(vntFilters) Step 2
        .Add vntFilters(i), vntFilters(i + 1), i \ 2 + 1
      Next i
    End With
    '表示するFilterを設定
    .FilterIndex = 1
    'MultiSelectを設定
    .AllowMultiSelect = blnMultiSel
    'ユーザーがボタンをクリック
    If .Show = -1 Then
      If blnMultiSel Then
        'ファイル名保存する配列を確保
        ReDim vntFileNames(1 To .SelectedItems.Count)
        'FileDialogSelectedItemsコレクション内のすべてのファイル名を取得
        i = 0
        For Each vntSelected In .SelectedItems
          '選択した各アイテムのパスを含む値を取得
          i = i + 1
          vntFileNames(i) = vntSelected
        Next vntSelected
      Else
        vntFileNames = .SelectedItems(1)
      End If
      '戻り値としてTrueを返す
      GetReadFile = True
    End If
  End With

  Set objFDL = Nothing
  
End Function

【66833】Re:開いたExcelのシート・セルの情報取得
お礼  ANTON  - 10/10/9(土) 0:40 -

引用なし
パスワード
   Hirofumiさん

こんなに長々と。。。有り難う御座います!
コピーして貼り付けて実験しました所、私がやりたかったことができてるみたいです!!
今までコピー作業とExcelを開くという作業を別のユーザーフォームに拘ってしまった事が最大のミスだったようですね。。。
固執する理由はないはずなのに。。。w
また、今までコンボボックスやRef Editなどは使用方法がわからず使っておりませんでしたが、こんなに便利になるのかと驚きました。


ただ、これをこのままコピーして流用したのでは私自身のスキルアップにならないので、一行ずつじっくりと意味を理解しながら自分のマクロに応用していきたいと思います。


以後、私も質問に答えてあげられる側となれるよう日々精進していく所存です。
この度は本当に助かりました。ありがとうございましたm(_ _)m

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