diff --git a/RelaxTools.xlam b/RelaxTools.xlam index 0780eab..38b848f 100644 Binary files a/RelaxTools.xlam and b/RelaxTools.xlam differ diff --git a/Source/RelaxTools.xlsm b/Source/RelaxTools.xlsm index 01c5f6e..44af285 100644 Binary files a/Source/RelaxTools.xlsm and b/Source/RelaxTools.xlsm differ diff --git a/Source/src/Class/SelectionColFramework.cls b/Source/src/Class/SelectionColFramework.cls index f747585..3470855 100644 --- a/Source/src/Class/SelectionColFramework.cls +++ b/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) diff --git a/Source/src/Class/SelectionRowFrameWork.cls b/Source/src/Class/SelectionRowFrameWork.cls index 498c839..8417984 100644 --- a/Source/src/Class/SelectionRowFrameWork.cls +++ b/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) diff --git a/Source/src/Form/frmCrossLine.frm b/Source/src/Form/frmCrossLine.frm index ea47bb7..5ff6132 100644 --- a/Source/src/Form/frmCrossLine.frm +++ b/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 diff --git a/Source/src/Form/frmMergeFile.frm b/Source/src/Form/frmMergeFile.frm index c12228a..8e79c88 100644 --- a/Source/src/Form/frmMergeFile.frm +++ b/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() diff --git a/Source/src/Form/frmPageList.frm b/Source/src/Form/frmPageList.frm index 47b1658..b46dc1e 100644 --- a/Source/src/Form/frmPageList.frm +++ b/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 diff --git a/Source/src/Form/frmStaticCheck.frm b/Source/src/Form/frmStaticCheck.frm index 40cf015..8c243b1 100644 --- a/Source/src/Form/frmStaticCheck.frm +++ b/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 diff --git a/Source/src/Microsoft Excel Objects/ThisWorkbook.cls b/Source/src/Microsoft Excel Objects/ThisWorkbook.cls index da0b7db..c9f8f3f 100644 --- a/Source/src/Microsoft Excel Objects/ThisWorkbook.cls +++ b/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 diff --git a/Source/src/Modules/basSelection.bas b/Source/src/Modules/basSelection.bas index 2a3195c..c6e7a40 100644 --- a/Source/src/Modules/basSelection.bas +++ b/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 diff --git a/Source/src/Modules/basSetting.bas b/Source/src/Modules/basSetting.bas index 530d19d..5b976d2 100644 --- a/Source/src/Modules/basSetting.bas +++ b/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) diff --git a/Source/src/Modules/basShowForm.bas b/Source/src/Modules/basShowForm.bas index e5e106c..8555db8 100644 --- a/Source/src/Modules/basShowForm.bas +++ b/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 diff --git a/Version.txt b/Version.txt index ffb3fc0..e781137 100644 --- a/Version.txt +++ b/Version.txt @@ -4,6 +4,8 @@ ◇バグ修正 ・全角文字列存在チェックでUndoが効かない不具合を修正。 ◇機能改善 +・ページ数取得でExcelブックの場合シート毎のページ数をだせるように改善。 +・十字カーソルのガイドの透明度を設定できるように改善。 ・結合セルを含む選択範囲での処理高速化。 ・A1保存のチェック処理簡略化。高速化を図る。 ・アイコンをちょとちょこと変更。