VBA - Visual Basic for Applications

The following looked simple enough for me.

Source Code

Here a solution, which works for me however you have to be careful since it relies on a certain environment variable to be present. If this environment variable is not available the method automatically assumes the os to operate in 32 bit.

1
2
3
4
5
6
7
8
' @Author - Alexander Bolte
' @ChangeDate - 2016-03-27
' @Description - Determines if a users operating system is of 64 bit or 32 bit.
' In a 32 bit windows operating system the environment variable "ProgramW6432" simply does not exist.
' @Returns true, if the default directory for 32 bit applications is C:\Program Files (x86), else false.
Function Is64bit() As Boolean
    Is64bit = Len(Environ("ProgramW6432")) > 0
End Function

Unfortunately thie below did not work for me as it returned "x86" no matter if I started it on a 64 bit or 32 bit os.

1
2
3
Sub testArchitecture()
    MsgBox Environ("PROCESSOR_ARCHITECTURE")
End Sub

 

Recently I had to link tables from one access file in another access file.

I did not intend to document such a trivial task on my webpage, but since the function I copied from the internet ran into an endless loop after I only provided an invalid file path I decided to implement something myself.

Enjoy.

' @Author
'   Alexander Bolte
'
' @ChangeDate
'   2014-07-29
'
' @Description
'   Linking given table from given source Access database in CurrentDb under provided target name.
'   If a linked table already exists under given name, the link will be broken and replaced with the new one.
'
' @Param strDatabaseSource
'   String providing the full path of the source access database.
' @Param strTableSource
'   String providing the source table name in the source access database.
' @Param strTableDestination
'   String providing the target table name in CurrentDB.
' @Return
'   True, if linkage succeeded, else false.
Public Function LinkTable( _
        ByVal strDatabaseSource As String, _
        ByVal strTableSource As String, ByVal strTableDestination As String _
    ) As Boolean
    Dim dbSource As DAO.Database
    Dim dbTarget As DAO.Database
    Dim dbDestination As DAO.Database
    Dim tdf As DAO.TableDef
   
On Error GoTo LinkTable_Err

    Call unlinkTable(strTableDestination)
    Set dbSource = DBEngine.Workspaces(0).OpenDatabase(strDatabaseSource)
    Set dbDestination = CurrentDb
    Set tdf = dbDestination.CreateTableDef(strTableDestination)
    tdf.Connect = ";DATABASE=" & strDatabaseSource
    tdf.SourceTableName = strTableSource
    dbDestination.TableDefs.Append tdf
    LinkTable = True
LinkTable_Err:
    If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, cDialogTitle
Err.Clear
LinkTable = False
    End If
   
    If Not (dbSource Is Nothing) Then
        dbSource.Close
        Set dbSource = Nothing
    End If
    Set dbDestination = Nothing
    Set tdf = Nothing
End Function 

Below method allows you to remove the shadow from all shapes of the same type (arrow, rectangle, ... ) at once, instead of selecting each shape manually.

If you want to apply more formats than only removing a shadow, then use the methods PickUp and Apply of the Shape object.

PickUp copies the format of one Shape object and Apply copies a before picked up format.

Source Code 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
' @Author - Alexander Bolte
' @ChangeDate - 2014-11-27
' @Description - removing a shadow from all objects of type Shape 
' of the same type (arrow, rectangle, ...) in current slides.
' Select one shape e.g. an arrow in a power point presentation and execute this code.
' The method iterates through all shapes in current ShapeRange and removes the 
' shadow style from all shapes of the same type.
Sub PickItUp()
    Dim oSld As Slide
    Dim oSelShp As Shape
    Dim oShp As Shape
    Dim lType As Long
 
    On Error GoTo err_handle:
 
    ' Results are unpredictable if you start with
    ' more than one shape selected.
    If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
        MsgBox "Select only one shape", vbExclamation, "Power Point"
	Exit Sub
    End If
 
    ' set a reference to the selected shape
    Set oSelShp = ActiveWindow.Selection.ShapeRange(1)
 
    With oSelShp
        ' pick up its formatting
        .PickUp
        ' store its type
        lType = .Type
 
        ' Exclude placeholders
        If lType = 14 Then
            Exit Sub
        End If
 
        If .Fill.Type = msoFillPicture Then
            Exit Sub
        End If
 
        For Each oSld In ActivePresentation.Slides
            For Each oShp In oSld.Shapes
                If oShp.Type = lType Then
                    If oShp.Fill.Type <> msoFillPicture Then
                        'oShp.Apply
                        oShp.Shadow.Visible = msoFalse
                    End If  ' <> msoFillPicture
                End If  ' Type - lType
            Next oShp
        Next oSld
    End With    ' oSelShp
 
err_handle:
    If Err.Number <> 0 Then
        Err.Clear
    End If
    MsgBox "Uncatched exception.", vbCritical, "Power Point"
End Sub

Subcategories

This category will hold articles regarding developement in Excel VBA. It will serve as a wiki and an Excel VBA Framework for myself.

Some development tasks reoccur for every customer. Since I am a lazy bum it will be nice to have a central source where I can reuse source code from.

This category holds articles regarding general things in MS Office VBA independent from the MS Office application.  

This category holds articles regarding Access VBA, but also general things I come accross Access and its usage in companies.