Pan Image with click and drag

Someone on MSDN asked a question about clicking and draging an image to pan around while zoomed. The control already did the zoom and consists of a picturebox within a panel with autoscroll turned on. This would let you use the scrollbars to navigate, but the poster wanted to pan by dragging so here it is. I will add to it as needed but this seemed to work pretty well.


Public Class Form1
Dim x1, y1 As Double
Dim scrollSensitivity As Double
Dim md As Boolean
Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
md = True
x1 = Me.Panel1.HorizontalScroll.Value
y1 = Me.Panel1.VerticalScroll.Value
End Sub
Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
scrollSensitivity = 4
If md = True Then
Try
Me.Panel1.HorizontalScroll.Value = (e.X - x1) / scrollSensitivity
Me.Panel1.VerticalScroll.Value = (e.Y - y1) / scrollSensitivity
Catch ex As Exception
End Try
End If
End Sub
Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
md = False
End Sub
End Class


VBA: Copy x sheet from each file in folder

Sub CopySheet()
Dim basebook As Workbook
Dim mybook As Workbook
Dim i As Long
Dim filePath As String
filePath = "C:\Documents and Settings\user\Desktop\Baskets\"
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .LookIn = filePath
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            Set basebook = ThisWorkbook
            For i = 1 To .FoundFiles.Count
                Set mybook = Workbooks.Open(.FoundFiles(i))
                    mybook.Worksheets("What Sells With My Item").Copy after:= _
                    basebook.Sheets(1)
                    ActiveSheet.Name = Mid(mybook.Name, 1, Len(mybook.Name) - 4)
               mybook.Close
        
           Next i
       End If
     
    End With
    Application.ScreenUpdating = True
End Sub

VBA: Random Letter generator

Private Sub MakeRandom()
Dim theNum As Double
Dim theUpper As String
Dim theLower As String

' Upper Case
theUpper = Chr(64 + Rnd() * 10000000 Mod 26)
' Lower Case
theLower = Chr(96 + Rnd() * 10000000 Mod 26)

End Sub

VBA: Manipulate registry *MAKE A BACKUP FIRST*

*Not responsible for those who mess up and didn't backup.

        Dim pRegKey As RegistryKey = Registry.CurrentUser
        pRegKey = pRegKey.OpenSubKey("Software\\Microsoft\\Internet Explorer\Main", True)
        'Dim val As Object = pRegKey.GetValue("Display Inline Images")
        pRegKey.SetValue("Display Inline Images", "no")

VBA: Extract all data from a closed workbook

Dim ConString As String
Dim strSQL    As String
Dim DBPATH    As String
Dim recordset As New ADODB.recordset

DBPATH = ThisWorkbook.Path & "\Data.xls"

ConString = "Provider=Microsoft.jet.oledb.4.0;" & _
                   "Data Source=" & DBPATH & ";" & _
                   "extended Properties=Excel 8.0;"

strSQL = "SELECT * FROM [Data$]"

Set recordset = New ADODB.recordset

On Error GoTo cleanup:

Call recordset.Open(strSQL, ConString, adOpenForwardOnly, adLockReadOnly,
CommandTypeEnum.adCmdText)

Call Sheets("DataDump").Range("A2").CopyFromRecordset(recordset)

Set recordset = Nothing

VBA: Find all files in folder by extension

Sub findBSAfiles()
 Dim objFSO    As Object
Dim objFolder As Object
Dim objFile   As Object
Dim strPath   As String
Dim strName   As String 
' Specify the folder...  
strPath = "pathname"
' Use Microsoft Scripting runtime.  
Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set objFolder = objFSO.GetFolder(strPath)   
' Check extension of each file in folder.  
For Each objFile In objFolder.Files    
If Right(objFile.Name, 4) = ".xls" Then
strName = strName & "**" & objFile.Name & "**" & vbCrLf  
End If
Next objFile ' Display file names in message box. 
MsgBox strName  
Set objFSO = Nothing  
Set objFolder = Nothing  
Set objFile = Nothing
End Sub

VBA: Remove buttons by name

'If the forms menu, use
Sub RemoveButtons()     
Dim ShapeA As Button     
For Each ShapeA In ActiveSheet.Buttons           
If ShapeA.Caption = "Doodle" Then ShapeA.Delete     
Next ShapeA
End Sub

'If from the control toolbox, use
Sub RemoveButtons()     
Dim ShapeA As OLEObject     
For Each ShapeA In ActiveSheet.OLEObjects           
If ShapeA.Object.Caption = "Doodle" Then ShapeA.Delete     
Next ShapeA
End Sub

VBA: Get pressed key

This was Basically part of a code database dump, but it is the most searched for post on here, and looking at it I don't think it's as helpful as it could be.

So, at the bottom I will leave the code that was originally here, but I will add more meaningful code and descriptions first.

For information on the codes for various keys, in the VBA editor search help for 'OnKey'.

The following will set you workbook to intercept the keys control C and fire an event.

Note that for testing you will have to click run on the open event to set it up, or close and re-open the workbook.

'Add this to the ThisWorkbook Open event

Private Sub Workbook_Open()
Application.OnKey "^{c}", "Key_Pressed"
End Sub

'Add this to a new module

Sub Key_Pressed()
'Do What You Want
End Sub

That's it. If you want to pass variables to your event, whether it is the key that was pressed or a value or anything else, you pass it along as a parameter like this.

Private Sub Workbook_Open()
Application.OnKey "^{c}", "'Key_Pressed""C""'"
End Sub

Sub Key_Pressed(key)
MsgBox key & " key was Pressed"
End Sub

'----Old Code----

Declare Function GetKeyState Lib "user32" _(ByVal nVirtKey As Long) As Integer
Const VK_CONTROL As Integer = &H11  'Ctrl
Sub test()   
If GetKeyState(VK_CONTROL) < 0 Then
Ctrl = True
Else Ctrl = False   
If Ctrl = True Then       
MsgBox "pressed"   
Else       
MsgBox "Not"    End IfEnd Sub

'And this in the sheet module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call test
End Sub

VBA: Open all workbooks inside a folder, run macro and save them

Sub LoopFolders()Dim oFSODim Folder As ObjectDim Files As ObjectDim file As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder("c:\MyTest")
For Each file In Folder.Files
If file.Type Like "*Microsoft Excel*" Then
Workbooks.Open Filename:=file.Path '<<<<< run macro here on Activeworkbook Activeworkbook.Close SaveChanges:=False
End If
Next file
Set oFSO = Nothing
End Sub

XML to Dataset

Here is some quick code illustrating how to put XML data into a dataset. Drom a datagridview on your form and drop in this code, change the table number near the end to suit your particular needs.

Imports System.IO
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'load xml into a dataset to use here
Dim dS As New DataSet
Dim fS As FileStream
'open the xml file so we can use it to fill the dataset
fS = New FileStream("C:\test\10g_2.xml", FileMode.Open)
'fill the dataset
Try
dS.ReadXml(fS)
Catch ex As Exception
MsgBox(ex)
Finally
fS.Close()
End Try
Me.DataGridView1.DataSource = dS.Tables(2)
End Sub
End Class

Copy & Paste Form Controls

My previous post worked with the chart controls in VS. While working on my own project I realized a need for the ability to copy the chart control and place it into another program such as Excel or Powerpoint.

I tried many combinations of things, but they just weren't working. Then I stumbled upon this article by Scott Lysle (http://www.a1vbcode.com/app-3902.asp) which made the whole thing easy. His method creates a .bmp image and saves it, I have adjusted it in two ways to accomplish my goal. First I turned it into a function that returned the image instead of saving it, and then I put it in the clipboard for ease of movement.

His code uses a datagridview as a source, but as he mentions in the write-up, it is easily adaptable for most any control by just changing the control type.

Here is the code to copy the datagridview that accompanies my chart:

Public Function Convertdg2BMP(ByVal dg As DataGridView)

dg.Refresh()
dg.Select()

Dim g As Graphics = dg.CreateGraphics
Dim ibitMap As New Bitmap(dg.ClientSize.Width, _
dg.ClientSize.Height, g)
Dim iBitMap_gr As Graphics = Graphics.FromImage(ibitMap)
Dim iBitMap_hdc As IntPtr = iBitMap_gr.GetHdc
Dim me_hdc As IntPtr = g.GetHdc

BitBlt(iBitMap_hdc, 0, 0, dg.ClientSize.Width, _
dg.ClientSize.Height, me_hdc, 0, 0, SRC)
g.ReleaseHdc(me_hdc)
iBitMap_gr.ReleaseHdc(iBitMap_hdc)

Return ibitMap
End Function

And here it is with the chart:


Public Function ConvertCH2BMP(ByVal ch As Chart)

ch.Refresh()
ch.Select()

Dim g As Graphics = ch.CreateGraphics
Dim ibitMap As New Bitmap(ch.ClientSize.Width, _
ch.ClientSize.Height, g)
Dim iBitMap_gr As Graphics = Graphics.FromImage(ibitMap)
Dim iBitMap_hdc As IntPtr = iBitMap_gr.GetHdc
Dim me_hdc As IntPtr = g.GetHdc
BitBlt(iBitMap_hdc, 0, 0, ch.ClientSize.Width, _
ch.ClientSize.Height, me_hdc, 0, 0, SRC)
g.ReleaseHdc(me_hdc)
iBitMap_gr.ReleaseHdc(iBitMap_hdc)

Return ibitMap
End Function

**You will need to add an imports:

Imports System.Drawing.Imaging

And then you will need this function pasted within your class:

Private Declare Auto Function BitBlt Lib "gdi32.dll" _
(ByVal pHdc As IntPtr, ByVal iX As Integer, _
ByVal iY As Integer, ByVal iWidth As Integer, _
ByVal iHeight As Integer, ByVal pHdcSource As IntPtr, _
ByVal iXSource As Integer, ByVal iYSource As Integer, _
ByVal dw As System.Int32) As Boolean
Private Const SRC As Integer = &HCC0020

Then just call the function you need based on the control (you could use just one, yes, but that is beyond the scope of this I think):

Clipboard.SetImage(ConvertCH2BMP(Me.Chart1))

I set mine up in a context menu so a right-click -> copy fires the code and then I go paste where I like.

VS 2010 Chart/Dundas Charting

I have worked on a very limited basis with Dundas (http://www.dundas.com/) charts in the past and have waited quite some time for charts to come to WinForms. VS2010 finally does this, and from what I can tell they are an exact replica of Dundas if not the actual chart themselves.

I built a project with the Dundas charts and had to tweek many of the parts, so this post will serve as a guide to working with Dundas charts and also VS2010 charts if they do prove to be identical in use as the initial project was built with Dundas, and this sample will use the WinForm chart.

Setting up data sources is the same in VS2010 as it was in previous versions so if you need more detailed instructions, refer to my earlier posts. In this sample I am using the Northwinds.mdb Products table.

Go ahead an drag a chart component onto your form, it should be in the toolbox under Data automatically. We will spend the next bit of time in the charts properties window, it is much easier to set up here than doing it entirely through code.

First thing I do is delete the Legend, you will notice it is a collection, just open it and remove. The next step is to drag the table onto the screen in the form of a DataGridView (check other posts on databinding if you don't know how), you might have to manually select it because in my Beta version None is selected by default. This creates your table adapters and binding sources etc and gives us something to look at to easily verify what we are doing.

Next step, in the properties window set your datasource to the newly created bindingsource. Now we want to modify the series collection, this is where most of the groundwork is done.

I changed the Name, made it a Line chart, and changed the X and Y value members under datasource, these only have selections available if you have binded the chart to a datasource already. This series is UnitsInStock and I will add one more showing UnitsOnOrder and will name it OnOrder:
I also changed the border width to make my line thicker and easier to see, you can also specify in this screen whether the data is on a secondary axis.

Now the chart looks OK, but there is too much data for it to be of much use. So lets filter this using a combobox to let us choose which departments to look at. Drag on a combobox and set the binding (so far in the Beta version, dragging the item from the data source does not actually bind the item) it should look like this:

Now we just need to set the logic up in code. Create an event for a combobox change and add this line:

Me.ProductsBindingSource.Filter = "CategoryID=" & Me.CategoryIDComboBox.Text

What you'll notice however is that the combobox is filled with multiples, and when you change the binding with the filter, you remove all of your selections. You can load the box manually, do buttons instead, any number of things, but I want to show you a way that you can use in other situations that aren't as straight forward.

In you DataSources window right-click on your DataSet and select Edit DataSet with Designer. Now copy the Products table and paste it, this will create another table called Products1. If you link these together, you will be able to make a selection in one which will cascade to another, very helpful but not a part of this post. In the new table choose Configure.

Hit next a couple of times until you get to the SQL and you see Query Builder. You can write the SQL yourself or take the easy route and just use the QB. In the end the SQL should look like this:

SELECT DISTINCT CategoryID

FROM Products

Note the Distinct, this will keep data from showing up multiple times. Keep hitting next and finally Finish. Next we need to update the binding on our ComboBox:

Notice we are opening the dataset and going with Products1 which is the new table we created. The code we have in the selected change is still valid so we can go ahead and run it.

Your data should change, but your chart should not. We need to rebind and update the chart, so at the bottom of the selectedChange event we will add:

Me.Chart1.DataBind()
Me.Chart1.Update()

Thats it, your chart should now update based upon your selection.

The next post will show how to tweak some things such as X and Y minimums and maximums as well as tooltips and labels.