Skip to content

Commit

Permalink
split DBModif into DBModif and DBModifHelper
Browse files Browse the repository at this point in the history
moved checkHiddenExcelInstance into Globals
improved comments and docs
createPivotTable now doesn't need a ExcelVersionForPivot setting, but determines the highest possible version itself.
fixed collectSettings.vbs to get really all settings and sort correctly
  • Loading branch information
rkapl123 committed Dec 30, 2024
1 parent 004e75e commit 865b547
Show file tree
Hide file tree
Showing 20 changed files with 976 additions and 934 deletions.
Binary file modified Distribution/DBaddin32.xll
Binary file not shown.
Binary file modified Distribution/DBaddin64.xll
Binary file not shown.
7 changes: 7 additions & 0 deletions docs/DBFuncs.md
Original file line number Diff line number Diff line change
Expand Up @@ -257,6 +257,13 @@ This builds a Powerquery compliant string (quoted using double quotes) from the

When E1 contains "test", this results in "a test".

#### preventRefresh

<pre lang="vb">preventRefresh(setPreventRefresh, onlyForThisWB (optional))</pre>

sets preventRefresh flag globally or just for the current workbook (if onlyForThisWB is set), similar to clicking the ribbon toggle button "refresh prevention". This setting is not persisted with the workbook!


### Modifications of DBFunc Behaviour

There are some options to modify
Expand Down
14 changes: 14 additions & 0 deletions docs/DBaddin.ldproj
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
<?xml version="1.0"?>
<project xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<files>
<file>../source/DBaddin.sln</file>
</files>
<RemovedAssemblies />
<filters>
<filter>Private</filter>
<filter>Protected</filter>
<filter>InternalProtected</filter>
</filters>
<configuration>Release</configuration>
<language>VisualBasic</language>
</project>
Binary file removed docs/Live Documenter.exe - Verknüpfung.lnk
Binary file not shown.
12 changes: 8 additions & 4 deletions source/AdHocSQL.vb
Original file line number Diff line number Diff line change
@@ -1,15 +1,16 @@
Imports System.Data
Imports System.ComponentModel ' for BackgroundWorker callback handling
Imports System.Data
Imports System.Windows.Forms
Imports System.ComponentModel ' for BackgroundWorker callback handling


''' <summary>User-form for ad-hoc SQL execution</summary>
Public Class AdHocSQL
''' <summary>common connection settings factored in helper class</summary>
Private myDBConnHelper As DBConnHelper
''' <summary>stored environment to reset after change</summary>
Private storedUserSetEnv As String = ""
Private ReadOnly storedUserSetEnv As String = ""
''' <summary>stored database to reset after change</summary>
Private userSetDB As String = ""
Private ReadOnly userSetDB As String = ""

''' <summary>create new AdHocSQL dialog</summary>
''' <param name="SQLString"></param>
Expand Down Expand Up @@ -322,6 +323,9 @@ Public Class AdHocSQL
sender.CurrentRow.Cells(e.ColumnIndex).TooltipText = "Data raised exception: " + e.Exception.Message + " (" + e.Context.ToString() + ")"
End Sub

''' <summary>show context menu for SQLText, displaying config menu as a MenuStrip</summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub SQLText_MouseDown(sender As Object, e As MouseEventArgs) Handles SQLText.MouseDown
If e.Button = Windows.Forms.MouseButtons.Right Then
Me.ConfigMenuStrip = ConfigFiles.ConfigContextMenu
Expand Down
30 changes: 8 additions & 22 deletions source/AddInEvents.vb
Original file line number Diff line number Diff line change
Expand Up @@ -4,24 +4,9 @@ Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel ' for event procedures...
Imports Microsoft.Office.Core
Imports Microsoft.Vbe.Interop
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Collections.Generic

Public Module CheckInstance
Public Sub checkHiddenExcelInstance()
Try
' check for multiple excel instances
If Process.GetProcessesByName("Excel").Length > 1 Then
For Each procinstance As Process In Process.GetProcessesByName("Excel")
If procinstance.MainWindowTitle = "" Then
UserMsg("Another hidden excel instance detected (PID: " + procinstance.Id + "), this may cause problems with querying DB Data")
End If
Next
End If
Catch ex As Exception : End Try
End Sub
End Module

''' <summary>AddIn Connection class, also handling Events from Excel (Open, Close, Activate)</summary>
<ComVisible(True)>
Expand Down Expand Up @@ -63,9 +48,9 @@ Public Class AddInEvents
End If
Catch ex As Exception : End Try
' for finding out what happened attach internal trace to ExcelDNA LogDisplay
theLogDisplaySource = New TraceSource("ExcelDna.Integration")
theLogDisplaySource = New Diagnostics.TraceSource("ExcelDna.Integration")
' and also define a LogSource for DBAddin itself for writing text log messages
theLogFileSource = New TraceSource("DBAddin")
theLogFileSource = New Diagnostics.TraceSource("DBAddin")

' IntelliSense needed for DB- and supporting functions
ExcelDna.IntelliSense.IntelliSenseServer.Install()
Expand Down Expand Up @@ -292,7 +277,7 @@ done:
''' <param name="Wb"></param>
Private Sub Application_WorkbookActivate(Wb As Excel.Workbook) Handles Application.WorkbookActivate
' avoid when being activated by DBFuncsAction
If Not DBModifs.preventChangeWhileFetching And Not Wb.IsAddin Then
If Not DBModifHelper.preventChangeWhileFetching And Not Wb.IsAddin Then
' in case AutoOpen hasn't been triggered (e.g. when Excel was started via Internet Explorer)...
If DBModifDefColl Is Nothing Then
DBModifDefColl = New Dictionary(Of String, Dictionary(Of String, DBModif))
Expand Down Expand Up @@ -343,7 +328,7 @@ done:
''' <param name="cbName">name of command button, defines whether a DBModification is invoked (starts with DBMapper/DBAction/DBSeqnce)</param>
Private Shared Sub cbClick(cbName As String)
' reset non interactive messages (used for VBA invocations) and hadError for interactive invocations
nonInteractiveErrMsgs = "" : DBModifs.hadError = False
nonInteractiveErrMsgs = "" : DBModifHelper.hadError = False
Dim DBModifType As String = Left(cbName, 8)
If DBModifType <> "DBSeqnce" Then
Dim targetRange As Excel.Range
Expand Down Expand Up @@ -418,15 +403,15 @@ done:
''' <param name="Sh"></param>
Private Sub Application_SheetActivate(Sh As Object) Handles Application.SheetActivate
' avoid when being activated by DBFuncsAction
If Not DBModifs.preventChangeWhileFetching Then
If Not DBModifHelper.preventChangeWhileFetching Then
' only when needed assign button handler for this sheet ...
If Not IsNothing(DBModifDefColl) AndAlso DBModifDefColl.Count > 0 Then assignHandler(Sh)
End If
End Sub

Private WbIsClosing As Boolean = False

''' <summary>Clean up after closing workbook, only set flag here, actual cleanup is only done if workbook is really closed (in WB_Deactivate event)</summary>
''' <summary>Clean up after closing workbook, only set flag here, the actual cleanup is only done if workbook is really closed (in WB_Deactivate event)</summary>
''' <param name="Wb"></param>
''' <param name="Cancel"></param>
Private Sub Application_WorkbookBeforeClose(Wb As Workbook, ByRef Cancel As Boolean) Handles Application.WorkbookBeforeClose
Expand All @@ -437,6 +422,7 @@ done:
''' <param name="Wb"></param>
Private Sub Application_WorkbookDeactivate(Wb As Workbook) Handles Application.WorkbookDeactivate
Try
If WbIsClosing AndAlso preventRefreshFlagColl.ContainsKey(Wb.Name) Then preventRefreshFlagColl.Remove(Wb.Name)
If WbIsClosing AndAlso Not IsNothing(DBModifDefColl) AndAlso DBModifDefColl.Count > 0 Then
DBModifDefColl.Clear()
theRibbon.Invalidate()
Expand All @@ -452,7 +438,7 @@ done:
''' <param name="Target"></param>
Private Sub Application_SheetChange(Sh As Object, Target As Range) Handles Application.SheetChange
' avoid entering into insert/update check resp. doCUDMarks if not list-object (data table), whole column modified, no DBMapper present and prevention while fetching (on refresh) being set
If Not IsNothing(Target.ListObject) AndAlso Not Target.Rows.Count = Sh.Rows.Count AndAlso DBModifDefColl.ContainsKey("DBMapper") AndAlso Not DBModifs.preventChangeWhileFetching Then
If Not IsNothing(Target.ListObject) AndAlso Not Target.Rows.Count = Sh.Rows.Count AndAlso DBModifDefColl.ContainsKey("DBMapper") AndAlso Not DBModifHelper.preventChangeWhileFetching Then
Dim targetName As String = getDBModifNameFromRange(Target)
If Left(targetName, 8) = "DBMapper" Then
DirectCast(DBModifDefColl("DBMapper").Item(targetName), DBMapper).insertCUDMarks(Target)
Expand Down
28 changes: 20 additions & 8 deletions source/ConfigFiles.vb
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ Public Module ConfigFiles
Public specialFolderMaxDepth As Integer
''' <summary>store found sub-menus in this collection</summary>
Private specialConfigFoldersTempColl As Collection
''' <summary>collection structure for the two menu types, one in ribbon (Xelement) and MenuStrip (ToolStripMenuItem, used in AdHocSQL/SQLText context menu)</summary>
Private Structure MenuClassStruct
Dim ribbonmenu As XElement
Dim contextmenu As ToolStripMenuItem
Expand Down Expand Up @@ -147,8 +148,9 @@ Public Module ConfigFiles

''' <summary>creates the ribbon config tree menu and the context menu for the AdHocSQL Dialog by reading the menu elements from the config store folder files/sub-folders</summary>
Public Sub createConfigTreeMenu()
Dim currentBar, button As XElement
Dim currentStrip As New ToolStripMenuItem
' collecting menu items in
Dim currentBar As XElement ' for ribbon
Dim currentStrip As New ToolStripMenuItem ' for context menu in AdHocSQL/SQLText

' also get the documentation that was provided in setting ConfigDocQuery into ConfigDocCollection (used in config menu when clicking entry + Ctrl/Shift)
Dim ConfigDocQuery As String = fetchSetting("ConfigDocQuery" + env(), fetchSetting("ConfigDocQuery", ""))
Expand All @@ -162,8 +164,8 @@ Public Module ConfigFiles
Else
' top level menu
currentBar = New XElement(xnspace + "menu")
' add refresh button to top level
button = New XElement(xnspace + "button")
' add refresh button to top level only for ribbon menu
Dim button As New XElement(xnspace + "button")
button.SetAttributeValue("id", "refreshConfig")
button.SetAttributeValue("label", "refresh DBConfig Tree")
button.SetAttributeValue("imageMso", "Refresh")
Expand All @@ -176,12 +178,13 @@ Public Module ConfigFiles
specialConfigFoldersTempColl = Nothing
ExcelDnaUtil.Application.StatusBar = ""
currentBar.SetAttributeValue("xmlns", xnspace)
' avoid exception in ribbon...
' avoid exception in ribbon by respecting the entry limit...
ConfigMenuXML = currentBar.ToString()
If ConfigMenuXML.Length > maxSizeRibbonMenu Then
UserMsg("Too many entries in " + ConfigStoreFolder + ", can't display them in a ribbon menu ..")
ConfigMenuXML = "<menu xmlns='" + xnspace.ToString() + "'><button id='refreshDBConfig' label='refresh DBConfig Tree' imageMso='Refresh' onAction='refreshDBConfigTree'/></menu>"
End If
' add all collected ToolStripMenuItem of currentStrip to top-level menu, copying needed because AddRange removes items from original collection
Dim addedContextMenu As ToolStripMenuItem()
ReDim addedContextMenu(currentStrip.DropDownItems.Count - 1)
currentStrip.DropDownItems.CopyTo(addedContextMenu, 0)
Expand Down Expand Up @@ -252,6 +255,7 @@ Public Module ConfigFiles
' normal case or max menu depth branch: just follow the path and enter all entries as buttons
Else
For i = 0 To UBound(fileList)
' add ribbon menu leaf element
newBar = New XElement(xnspace + "button")
menuID += 1
newBar.SetAttributeValue("id", "m" + menuID.ToString())
Expand All @@ -260,6 +264,7 @@ Public Module ConfigFiles
newBar.SetAttributeValue("label", Folderpath + Left$(fileList(i).Name, Len(fileList(i).Name) - 4))
newBar.SetAttributeValue("onAction", "getConfig")
currentBar.Add(newBar)
' add context menu strip leaf element (including event handler)
Dim eventHandler As New System.EventHandler(AddressOf contextMenuClickEventHandler)
newStrip = New ToolStripMenuItem(text:=Folderpath + Left$(fileList(i).Name, Len(fileList(i).Name) - 4), image:=Nothing, onClick:=eventHandler) With {
.Tag = rootPath + "\" + fileList(i).Name,
Expand All @@ -278,11 +283,13 @@ Public Module ConfigFiles
ExcelDnaUtil.Application.StatusBar = "Filling DBConfigs Menu: " + rootPath + "\" + DirList(i).Name
' only add new menu element if below max. menu depth for ribbons
If MenuFolderDepth < maxMenuDepth Then
' add ribbon menu element
newBar = New XElement(xnspace + "menu")
menuID += 1
newBar.SetAttributeValue("id", "m" + menuID.ToString())
newBar.SetAttributeValue("label", DirList(i).Name)
currentBar.Add(newBar)
' add context menu strip element (no event handler needed)
newStrip = New ToolStripMenuItem With {
.Text = DirList(i).Name
}
Expand All @@ -292,6 +299,7 @@ Public Module ConfigFiles
MenuFolderDepth -= 1
Else
newBar = currentBar
newStrip = currentStrip
readAllFiles(rootPath + "\" + DirList(i).Name, newBar, newStrip, Folderpath + DirList(i).Name + "\")
End If
Next
Expand All @@ -300,7 +308,7 @@ Public Module ConfigFiles
End Try
End Sub

''' <summary>the event-handler for the context menu entries of the AdHocSQL context menu</summary>
''' <summary>the event-handler for the context menu entries of the AdHocSQL context menu, used either to show the documentation for the entries or to insert the queries defined in the xcl files</summary>
''' <param name="sender">the tool-strip menu item that sent the event</param>
''' <param name="e"></param>
Public Sub contextMenuClickEventHandler(sender As Object, e As Object)
Expand All @@ -310,12 +318,12 @@ Public Module ConfigFiles
' get the file content defined in sender.Tag (absolute path of xcl definition file)
' ConfigArray: Configs are tab separated pairs of <RC location vbTab function formula> vbTab <...> vbTab...
Dim ConfigArray As String() = Split(getFileContent(sender.Tag), vbTab)
' fetch query out of DBListFetch definition
' fetch query from DBListFetch definition (includes quotes at beginning/end)
Dim functionParts As String() = functionSplit(ConfigArray(1), ",", """", "DBListFetch", "(", ")")
If functionParts IsNot Nothing Then
' either put query into SQLText content if empty
If theAdHocSQLDlg.SQLText.Text.Length = 0 Then
theAdHocSQLDlg.SQLText.Text = functionParts(0).Substring(1, functionParts(0).Length - 2)
theAdHocSQLDlg.SQLText.Text = functionParts(0).Substring(1, functionParts(0).Length - 2) ' remove quotes at beginning/end
Else
' or attach extracted table (after FROM part) to existing content, if a FROM part is available
Dim startPosOfTable As Integer = functionParts(0).IndexOf("FROM")
Expand Down Expand Up @@ -359,6 +367,7 @@ Public Module ConfigFiles
' end node: add callable entry (= button)
If InStr(1, nameParts, " ") = 0 Or MenuDepth >= specialFolderMaxDepth Or MenuDepth + MenuFolderDepth >= maxMenuDepth Then
Dim entryName As String = Mid$(fullPathName, InStrRev(fullPathName, "\") + 1)
' add ribbon menu leaf element
newBar = New XElement(xnspace + "button")
menuID += 1
newBar.SetAttributeValue("id", "m" + menuID.ToString())
Expand All @@ -367,6 +376,7 @@ Public Module ConfigFiles
newBar.SetAttributeValue("tag", fullPathName)
newBar.SetAttributeValue("onAction", "getConfig")
currentBar.Add(newBar)
' add context menu strip leaf element (including event handler)
Dim eventHandler As New System.EventHandler(AddressOf contextMenuClickEventHandler)
newStrip = New ToolStripMenuItem(text:=Left$(entryName, Len(entryName) - 4), image:=Nothing, onClick:=eventHandler) With {
.Tag = fullPathName,
Expand All @@ -385,11 +395,13 @@ Public Module ConfigFiles
newMenuClass.ribbonmenu = newBar
newMenuClass.contextmenu = newStrip
Else
' add ribbon menu element
newBar = New XElement(xnspace + "menu")
menuID += 1
newBar.SetAttributeValue("id", "m" + menuID.ToString())
newBar.SetAttributeValue("label", newName)
currentBar.Add(newBar)
' add context menu strip element (no event handler needed)
newStrip = New ToolStripMenuItem With {
.Text = newName
}
Expand Down
1 change: 1 addition & 0 deletions source/DBDocumentation.vb
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
Imports System.Windows.Forms

''' <summary>Simple Popup Window for displaying Database documentation</summary>
Public Class DBDocumentation
Private Sub CancelBtn_Click(sender As Object, e As EventArgs) Handles CancelBtn.Click
Me.Close()
Expand Down
Loading

0 comments on commit 865b547

Please sign in to comment.