・ページ数取得でExcelブックの場合シート毎のページ数をだせるように改善。

・十字カーソルのガイドの透明度を設定できるように改善。

Source/src/Class/SelectionColFramework.cls

@@ -158,7 +158,7 @@ Public Sub Run()
 
             For i = 1 To lngRows
                 ''フィルタおよび非表示対策。
-                If rArea(i, lngCur).Rows.Hidden Or rArea(i, lngCur).Columns.Hidden Or r.MergeArea(1).Address <> r.Address Then
+                If rArea(i, lngCur).Rows.Hidden Or rArea(i, lngCur).Columns.Hidden Or rArea(i, lngCur).MergeArea(1).Address <> rArea(i, lngCur).Address Then
                 Else
                     If r Is Nothing Then
                         Set r = rArea(i, lngCur)

Source/src/Class/SelectionRowFrameWork.cls

@@ -159,7 +159,7 @@ Public Sub Run()
 
             For i = 1 To lngCols
                 ''フィルタおよび非表示対策。
-                If rArea(lngCur, i).Rows.Hidden Or rArea(lngCur, i).Columns.Hidden Or r.MergeArea(1).Address <> r.Address Then
+                If rArea(lngCur, i).Rows.Hidden Or rArea(lngCur, i).Columns.Hidden Or rArea(lngCur, i).MergeArea(1).Address <> rArea(lngCur, i).Address Then
                 Else
                     If r Is Nothing Then
                         Set r = rArea(lngCur, i)

Source/src/Form/frmCrossLine.frm

@@ -1,10 +1,10 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmCrossLine 
    Caption         =   "十字カーソル設定"
-   ClientHeight    =   4710
+   ClientHeight    =   4245
    ClientLeft      =   45
    ClientTop       =   435
-   ClientWidth     =   6780
+   ClientWidth     =   6375
    OleObjectBlob   =   "frmCrossLine.frx":0000
    StartUpPosition =   1  'オーナー フォームの中央
 End
@@ -74,6 +74,8 @@ Private Sub cmdInit_Click()
     lblEven.BackColor = &H50B000
     txtCol.Value = "2"
     lblFont.BackColor = &H50B000
+    lblBack.BackColor = &HFFFFFF
+    txtGuidTransparency.Value = "50"
 
 End Sub
 
@@ -90,6 +92,8 @@ Private Sub cmdOk_Click()
     Dim blnEdit As Boolean
     Dim strFontColor As String
     Dim blnLineWidth As Boolean
+    Dim strBackColor As Long
+    Dim strGuidTransparency As String
 
 
     Select Case Val(txtFillTransparency.Value)
@@ -133,7 +137,11 @@ Private Sub cmdOk_Click()
 
     strFontColor = "&H" & Right$("00000000" & Hex(lblFont.BackColor), 8)
 
-    Call setCrossLineSetting(lngType, blnFillVisible, strFillColor, strFillTransparency, strLineVisible, strLineColor, strLineWeight, blnGuid, strFontColor, blnEdit, blnLineWidth)
+    strBackColor = "&H" & Right$("00000000" & Hex(lblBack.BackColor), 8)
+
+    strGuidTransparency = txtGuidTransparency.Value
+
+    Call setCrossLineSetting(lngType, blnFillVisible, strFillColor, strFillTransparency, strLineVisible, strLineColor, strLineWeight, blnGuid, strFontColor, blnEdit, blnLineWidth, strBackColor, strGuidTransparency)
 
 
     Unload Me
@@ -144,6 +152,21 @@ Private Sub CommandButton1_Click()
 
 End Sub
 
+Private Sub lblBack_Click()
+
+    Dim lngColor As Long
+    Dim Result As VbMsgBoxResult
+
+    lngColor = lblBack.BackColor
+
+    Result = frmColor.Start(lngColor)
+
+    If Result = vbOK Then
+        lblBack.BackColor = lngColor
+    End If
+
+End Sub
+
 Private Sub lblFillColor_Click()
 
     Dim lngColor As Long
@@ -259,6 +282,14 @@ Private Sub spnFillTransparency_SpinUp()
     txtFillTransparency.Text = spinUp(txtFillTransparency.Text)
 End Sub
 
+Private Sub spnGuidTransparency_SpinDown()
+    txtGuidTransparency.Text = spinDown(txtGuidTransparency.Text)
+End Sub
+
+Private Sub spnGuidTransparency_SpinUp()
+    txtGuidTransparency.Text = spinUp(txtGuidTransparency.Text)
+End Sub
+
 Private Sub UserForm_Initialize()
 
     Dim blnFillVisible As Boolean
@@ -273,8 +304,10 @@ Private Sub UserForm_Initialize()
     Dim blnGuid As Boolean
     Dim blnEdit As Boolean
     Dim blnLineWidth As Boolean
+    Dim lngBackColor As Long
+    Dim dblGuidTransparency As Double
 
-    Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth)
+    Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth, lngBackColor, dblGuidTransparency)
 
 
 
@@ -304,6 +337,8 @@ Private Sub UserForm_Initialize()
     txtCol.Value = sngLineWeight
 
     lblFont.BackColor = lngFontColor
+    lblBack.BackColor = lngBackColor
 
+    txtGuidTransparency.Value = dblGuidTransparency
 
 End Sub

Source/src/Form/frmMergeFile.frm

@@ -191,6 +191,10 @@ pass:
 
     MsgBox "マージしました。", vbOKOnly + vbInformation, C_TITLE
     motoWB.Worksheets(1).Select
+
+    Call SaveSetting(C_TITLE, "MergeFiles", "chkLink", chkLink.Value)
+    Call SaveSetting(C_TITLE, "MergeFiles", "FolderStr", txtFolder.Text)
+
     Exit Sub
 
 
@@ -248,7 +252,10 @@ End Sub
 Private Sub UserForm_Initialize()
     lblGauge.visible = False
     mblnCancel = False
-'    chkLink.Value = True
+
+    chkLink.Value = GetSetting(C_TITLE, "MergeFiles", "chkLink", False)
+    txtFolder.Text = GetSetting(C_TITLE, "MergeFiles", "FolderStr", "")
+
 End Sub
 
 Private Sub UserForm_Terminate()

Source/src/Form/frmPageList.frm

@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmPageList 
    Caption         =   "ページ数の取得"
-   ClientHeight    =   2760
+   ClientHeight    =   3075
    ClientLeft      =   45
    ClientTop       =   435
    ClientWidth     =   8040
@@ -208,7 +208,7 @@ Private Sub cmdOk_Click()
         Dim pt As Object
         Set PP = CreateObject("PowerPoint.Application")
     End If
-    
+
     lngBookCount = 0
     lngBookMax = colBook.count
     mMm.StartGauge lngBookMax
@@ -221,7 +221,7 @@ Private Sub cmdOk_Click()
 
         Err.Clear
 
-        ResultWS.Cells(lngCount, C_SEARCH_NO).Value = lngCount - C_START_ROW + 1
+        ResultWS.Cells(lngCount, C_SEARCH_NO).Value = lngBookCount + 1 'lngCount - C_START_ROW + 1
         ResultWS.Cells(lngCount, C_SEARCH_BOOK).Value = varBook
 
         ResultWS.Hyperlinks.Add _
@@ -235,14 +235,31 @@ Private Sub cmdOk_Click()
 
                 Set WB = XL.Workbooks.Open(filename:=varBook, ReadOnly:=True, UpdateLinks:=0, IgnoreReadOnlyRecommended:=True)
 
+                Dim w As Long
                 lngPage = 0
+                w = lngCount
+
+
                 For Each WS In WB.Worksheets
                     If WS.visible = xlSheetVisible Then
-                        lngPage = lngPage + (WS.VPageBreaks.count + 1) * (WS.HPageBreaks.count + 1)
+
+                        Dim p As Long
+
+                        p = (WS.VPageBreaks.count + 1) * (WS.HPageBreaks.count + 1)
+
+                        If chkExcelSheet.Value Then
+                            lngCount = lngCount + 1
+                            ResultWS.Cells(lngCount, C_SEARCH_PAGE).Value = p
+                            ResultWS.Cells(lngCount, C_SEARCH_BOOK).Value = "  " & WS.Name
+                        End If
+
+                        lngPage = lngPage + p
+
                     End If
                 Next
+
 
-                ResultWS.Cells(lngCount, C_SEARCH_PAGE).Value = lngPage
+                ResultWS.Cells(w, C_SEARCH_PAGE).Value = lngPage
                 WB.Close SaveChanges:=False
                 Set WB = Nothing
 
@@ -292,9 +309,6 @@ Private Sub cmdOk_Click()
     r.VerticalAlignment = xlTop
     r.Select
 
-
-
-
     Dim strBuf As String
     Dim i As Long
 
@@ -311,10 +325,8 @@ Private Sub cmdOk_Click()
         End If
     Next
     SaveSetting C_TITLE, "ExcelPages", "FolderStr", strBuf
-
-
     SaveSetting C_TITLE, "ExcelPages", "chkSubFolder", chkSubFolder.Value
-
+    SaveSetting C_TITLE, "ExcelPages", "chkExcelSheet", chkExcelSheet.Value
 
     Set mMm = Nothing
 
@@ -323,7 +335,7 @@ Private Sub cmdOk_Click()
     AppActivate ResultWS.Application.Caption
     execSelectionRowDrawGrid
     Set ResultWS = Nothing
-    
+
 End Sub
 Private Sub FileSearch(objFs As Object, strPath As String, strPatterns() As String, objCol As Collection)
 
@@ -393,6 +405,7 @@ Private Sub UserForm_Initialize()
     chkPoint.Value = True
 
     chkSubFolder.Value = GetSetting(C_TITLE, "ExcelPages", "chkSubFolder", False)
+    chkExcelSheet.Value = GetSetting(C_TITLE, "ExcelPages", "chkExcelSheet", False)
 
 End Sub
 

Source/src/Form/frmStaticCheck.frm

@@ -441,6 +441,43 @@ Private Sub checkSheetHyperlink(ByVal strCheck As String)
             End If
         Next
 
+
+
+'        'ブックのリンクがあったら解除
+'        Dim LK As Variant
+'        Dim a As Variant
+'
+'
+'        a = WB.LinkSources(Type:=xlLinkTypeExcelLinks)
+'
+'        If Not IsEmpty(a) Then
+'            For Each LK In WB.LinkSources(Type:=xlLinkTypeExcelLinks)
+'                WB.BreakLink Name:=LK, Type:=xlLinkTypeExcelLinks
+'            Next
+'        End If
+
+
+
+
+'        '画面レイアウトのリンクを削除
+'        Dim ss As Picture
+'        For Each ss In WS.Pictures
+'
+'            If ss.HasFormula And InStr(ss.Formula, "\") > 0 Then
+'                lstResult.AddItem ""
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_NO) = lstResult.ListCount
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_STR) = strCheck
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_ADDRESS) = r.Address(RowAbsolute:=False, ColumnAbsolute:=False)
+'
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_SHEET) = WS.Name
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_ID) = ""
+'                lstResult.List(lstResult.ListCount - 1, C_SEARCH_BOOK) = WB.Name
+'            End If
+'
+'        Next
+
+
+
     Next
 
 

Source/src/Microsoft Excel Objects/ThisWorkbook.cls

@@ -365,8 +365,10 @@ Private Sub addCrossLine()
         Dim lngFontColor As Long
         Dim blnEdit As Boolean
         Dim blnLineWidth As Boolean
+        Dim lngBackColor As Long
+        Dim dblGuidTransparency As Double
 
-        Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth)
+        Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth, lngBackColor, dblGuidTransparency)
 
 
         If lngType And C_HOLIZON Then
@@ -541,8 +543,10 @@ Private Sub XL_LINE_SheetSelectionChange(ByVal sh As Object, ByVal Target As Ran
     Dim lngFontColor As Long
     Dim blnEdit As Boolean
     Dim blnLineWidth As Boolean
+    Dim lngBackColor As Long
+    Dim dblGuidTransparency As Double
 
-    Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth)
+    Call getCrossLineSetting(lngType, blnFillVisible, lngFillColor, dblFillTransparency, lngLineVisible, lngLineColor, sngLineWeight, strOnAction, blnGuid, lngFontColor, blnEdit, blnLineWidth, lngBackColor, dblGuidTransparency)
 
     '横軸
     If lngType And C_HOLIZON Then
@@ -629,8 +633,9 @@ Private Sub XL_LINE_SheetSelectionChange(ByVal sh As Object, ByVal Target As Ran
             .visible = True
 '            .ForeColor.RGB = lngFillColor
 '            .Transparency = 0
-            .ForeColor.RGB = vbWhite
-            .Transparency = 0
+'            .ForeColor.RGB = vbWhite
+            .ForeColor.RGB = lngBackColor
+            .Transparency = dblGuidTransparency / 100
             .Solid
         End With
 

Source/src/Modules/basSelection.bas

@@ -708,8 +708,6 @@ Sub execSelectionRowDrawGrid()
     obj.EvenColor = -1
     obj.Custom = False
 
-'    obj.HoganMode = True
-
     obj.Run
 
     Set obj = Nothing

Source/src/Modules/basSetting.bas

@@ -30,7 +30,7 @@ Attribute VB_Name = "basSetting"
 '-----------------------------------------------------------------------------------------------------
 Option Explicit
 Option Private Module
-Sub getCrossLineSetting(ByRef lngType As Long, ByRef blnFillVisible As Boolean, ByRef lngFillColor As Long, ByRef dblFillTransparency As Double, ByRef lngLineVisible As Long, ByRef lngLineColor As Long, ByRef sngLineWeight As Single, ByRef strOnAction As String, ByRef blnGuid As Boolean, ByRef lngFontColor As Long, ByRef blnEdit As Boolean, ByRef blnLineWidth As Boolean)
+Sub getCrossLineSetting(ByRef lngType As Long, ByRef blnFillVisible As Boolean, ByRef lngFillColor As Long, ByRef dblFillTransparency As Double, ByRef lngLineVisible As Long, ByRef lngLineColor As Long, ByRef sngLineWeight As Single, ByRef strOnAction As String, ByRef blnGuid As Boolean, ByRef lngFontColor As Long, ByRef blnEdit As Boolean, ByRef blnLineWidth As Boolean, ByRef lngFBackColor As Long, ByRef dblGuidTransparency As Double)
 
     lngType = Val(GetSetting(C_TITLE, "CrossLine", "Type", C_ALL))
     blnFillVisible = GetSetting(C_TITLE, "CrossLine", "FillVisible", True)
@@ -48,9 +48,12 @@ Sub getCrossLineSetting(ByRef lngType As Long, ByRef blnFillVisible As Boolean,
     blnLineWidth = GetSetting(C_TITLE, "CrossLine", "LineWidth", False)
 
     lngFontColor = CLng(GetSetting(C_TITLE, "CrossLine", "FontColor", "&H0050B000"))
+    lngFBackColor = CLng(GetSetting(C_TITLE, "CrossLine", "BackColor", "&H00FFFFFF"))
+
+    dblGuidTransparency = Val(GetSetting(C_TITLE, "CrossLine", "GuidTransparency", "100"))
 
 End Sub
-Sub setCrossLineSetting(ByVal strType As String, ByVal strFillVisible As String, ByVal strFillColor As String, ByVal strFillTransparency As String, ByVal strLineVisible As String, ByVal strLineColor As String, ByVal strLineWeight As String, ByVal blnGuid As Boolean, ByVal strFontColor As String, ByVal blnEdit As Boolean, ByVal blnLineWidth As Boolean)
+Sub setCrossLineSetting(ByVal strType As String, ByVal strFillVisible As String, ByVal strFillColor As String, ByVal strFillTransparency As String, ByVal strLineVisible As String, ByVal strLineColor As String, ByVal strLineWeight As String, ByVal blnGuid As Boolean, ByVal strFontColor As String, ByVal blnEdit As Boolean, ByVal blnLineWidth As Boolean, ByVal strFBackColor As String, ByVal strGuidTransparency As String)
 
     Call SaveSetting(C_TITLE, "CrossLine", "Type", strType)
     Call SaveSetting(C_TITLE, "CrossLine", "FillVisible", strFillVisible)
@@ -66,6 +69,9 @@ Sub setCrossLineSetting(ByVal strType As String, ByVal strFillVisible As String,
     Call SaveSetting(C_TITLE, "CrossLine", "Guid", blnGuid)
     Call SaveSetting(C_TITLE, "CrossLine", "Edit", blnEdit)
     Call SaveSetting(C_TITLE, "CrossLine", "LineWidth", blnLineWidth)
+    Call SaveSetting(C_TITLE, "CrossLine", "BackColor", strFBackColor)
+
+    Call SaveSetting(C_TITLE, "CrossLine", "GuidTransparency", strGuidTransparency)
 
 End Sub
 Sub getCopyScreenSetting(ByRef blnFillVisible As Boolean, ByRef lngFillColor As Long, ByRef blnLine As Boolean)

Source/src/Modules/basShowForm.bas

@@ -371,9 +371,9 @@ End Sub
 Sub showGrammer()
     frmGrammer.show
 End Sub
-Sub showInfo()
-    frmInfo.show
-End Sub
+'Sub showInfo()
+'    frmInfo.show
+'End Sub
 'Sub showHoldBook()
 '    frmHoldBook.Show
 'End Sub

Version.txt

@@ -4,6 +4,8 @@
 ◇バグ修正
 ・全角文字列存在チェックでUndoが効かない不具合を修正。
 ◇機能改善
+・ページ数取得でExcelブックの場合シート毎のページ数をだせるように改善。
+・十字カーソルのガイドの透明度を設定できるように改善。
 ・結合セルを含む選択範囲での処理高速化。
 ・A1保存のチェック処理簡略化。高速化を図る。
 ・アイコンをちょとちょこと変更。