Excel VBA質問箱 IV

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

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


38329 / 76738 ←次へ | 前へ→

【43547】Re:非表示してる行を参照している側でも...
発言  ハチ  - 06/10/19(木) 9:57 -

引用なし
パスワード
   ▼スプーン さん:
>どうも始めまして
>初歩的な事かもしれませんがお願いします。

先の回答されているお二方も書かれている通り、簡単ではないです。
なぜ、そうしたいのか?をハッキリさせると別案もあるかもしれません。

>数量などを別ファイルから参照してるのですが
>例えば
>=[在庫表.xls]sheet1!A1
>
>その別ファイルで非表示されてる行を
>参照してる側のファイルでも
>非表示にしたいのです。

興味が湧いたので作ってみました。
参照されているBook(別ファイルと書かれているBookです)に
下記のマクロを記述して先に開いて置くのが前提です。
別のBookを開くときにチェックがかかります。
対象であれば使用している全セルをチェックするので
正直、実用的なサンプルとは言い難いですが・・・
テストでは動作しましたが、バグがあるかもしれません。
自信なしです。お暇なら程度で見てください。

ワークシート分析の参照元のトレース を使ってみました。
リンクのチェックがJakaさんがUPされているマクロをお借りしました。

'ThisWorkBookモジュール
Option Explicit
Dim WithEvents App As Application

Private Sub Workbook_Open()
  Set App = Application
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Set App = Nothing
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
  Call LinkChk(Wb)
End Sub

'標準モジュール
Option Explicit

Sub LinkChk(Wb As Workbook)
'このBookにLinkされているかチェック
  Dim i As Long
  Dim LinkBookTB As Variant
  
  LinkBookTB = Wb.LinkSources(Type:=xlLinkTypeExcelLinks)
  If Not IsEmpty(LinkBookTB) Then
  For i = 1 To UBound(LinkBookTB)
    If LinkBookTB(i) = ThisWorkbook.FullName Then
      Call Hidden_Link_Hidden(Wb)
      Exit Sub
    End If
  Next i
End If
End Sub

Sub Hidden_Link_Hidden(Wb As Workbook)
'ワークシート分析-参照元のトレース を使用する。
'参照元の行が非表示であれば、参照先も非表示にする。
'NavigateArrow ArrowNumber 1が外部リンクになると仮定。間違ってたらゴメンナサイ
  Dim R As Range '参照先Range
  Dim R2 As Range '参照元Range
  Dim Ws As Worksheet
  Dim i As Integer
  
  Application.ScreenUpdating = False
  For Each Ws In Wb.Worksheets
    For Each R In Ws.UsedRange
      R.ShowPrecedents  'ワークシート分析-参照元のトレース
      If IsEmpty(R.NavigateArrow(True, 1)) = False Then
        i = 0
        On Error Resume Next
          Do
            i = i + 1
            Err.Clear
            Set R2 = R.NavigateArrow(True, 1, i)
            'リンク元Bookとリンク先Bookが同一ならDo終了 次セルへ
            If R2.Parent.Parent.Name = R.Parent.Parent.Name Then Exit Do
            If Err.Number = 0 And R2.EntireRow.Hidden = True Then
              R.EntireRow.Hidden = True
            End If
          Loop While Err.Number = 0
        On Error GoTo 0
      End If
      R.ShowPrecedents True
    Next R
  Next Ws
  Application.ScreenUpdating = True
  Wb.Activate
  Wb.Worksheets(1).Activate
End Sub
0 hits

【43482】非表示してる行を参照している側でも非表示したい スプーン 06/10/17(火) 8:19 質問
【43487】Re:非表示してる行を参照している側でも非... Jaka 06/10/17(火) 12:46 発言
【43494】Re:非表示してる行を参照している側でも非... Kein 06/10/17(火) 15:17 発言
【43547】Re:非表示してる行を参照している側でも... ハチ 06/10/19(木) 9:57 発言

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