VBA-overig

De volgende onderwerpen komen hier aan bod:

Office 2013 en Windows 8.x: Clipboard

In VBA kunt u op eenvoudige wijze het clipboard gebruiken:

Dim Clipboard As New DataObject
Clipboard.Clear
Clipboard. SetText "Tekst voor op het kladblok"

Echter in Windows 8.x werkt deze code niet meer. Microsoft onderkent het probleem maar heeft (nog) geen oplossing.

U kunt met onderstaande (algemene) module het probleem ondervangen:

Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
 ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
 ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
 As Long, ByVal hMem As Long) As Long
 Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _
 Long) As Long
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
 
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
 Dim hGlobalMemory As Long, lpGlobalMemory As Long
 Dim hClipMemory As Long, X As Long
 
 ' Allocate moveable global memory.
 '-------------------------------------------
 hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
 
 ' Lock the block to get a far pointer
 ' to this memory.
 lpGlobalMemory = GlobalLock(hGlobalMemory)
 
 ' Copy the string to this global memory.
 lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
 
 ' Unlock the memory.
 If GlobalUnlock(hGlobalMemory) <> 0 Then
 MsgBox "Could not unlock memory location. Copy aborted."
 GoTo OutOfHere2
 End If
 
 ' Open the Clipboard to copy data to.
 If OpenClipboard(0&) = 0 Then
  MsgBox "Could not open the Clipboard. Copy aborted."
  Exit Function
 End If
 
 ' Clear the Clipboard.
 X = EmptyClipboard()
 
 ' Copy the data to the Clipboard.
 hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
 
OutOfHere2:
 
 If CloseClipboard() = 0 Then
  MsgBox "Could not close Clipboard."
 End If
 
End Function
Function ClipBoard_GetData(ByVal Dummy As String)
 Dim hClipMemory As Long
 Dim lpClipMemory As Long
 Dim MyString As String
 Dim RetVal As Long
 
 If OpenClipboard(0&) = 0 Then
 MsgBox "Cannot open Clipboard. Another app. may have it open"
 Exit Function
 End If
 
 ' Obtain the handle to the global memory
 ' block that is referencing the text.
 hClipMemory = GetClipboardData(CF_TEXT)
 If IsNull(hClipMemory) Then
  MsgBox "Could not allocate memory"
  GoTo OutOfHere
 End If
 
 ' Lock Clipboard memory so we can reference
 ' the actual data string.
 lpClipMemory = GlobalLock(hClipMemory)
 
 If Not IsNull(lpClipMemory) Then
  MyString = Space$(MAXSIZE)
  RetVal = lstrcpy(MyString, lpClipMemory)
  RetVal = GlobalUnlock(hClipMemory)
 
  ' Peel off the null terminating character.
  MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
 Else
  MsgBox "Could not lock memory to copy string from."
 End If
 
OutOfHere:
 
 RetVal = CloseClipboard()
 ClipBoard_GetData = MyString
 
End Function

Naar boven

Zet Excel-reeks om in een rij

Multidimensionale dynamische array’s

Om een Excel-reeks (Range) in VBA om te zetten naar een rij moet u gebruik maken van een multidimensionale dynamische array.

Dit komt bijvoorbeeld voor als u van een reeks getallen wat beschrijvende statistieken wilt bepalen; bijvoorbeeld kwartiel-bereik.

Het probleem is dat u van te voren, dus wanneer u de code maakt, niet weet hoe groot de Range is.

Hieronder staat een Sub dat een reeks in een array zal neerzetten:

Sub Reeks2Rij()
    Dim reeks As Range 'alleen voor test-doeleinden
    Dim tmpreeks() As Variant
    Dim rij() As Variant
    Dim r As Integer, k As Integer, i As Integer
    Dim dimensie As Integer
    Dim regels As Integer, kolommen As Integer
    
    'normaal geeft u reeks als value-paramter mee aan de sub, dus
    'Sub Reeks2Rij(ByVal reeks as Range)
    Set reeks = Application.ActiveSheet.Range("B2:D4")
    
    regels = reeks.Rows.Count 'aantal regels van de reeks
    kolommen = reeks.Columns.Count 'aantal kolommen van de reeks
    dimensie = regels * kolommen 'aantal elementen van de rij
    ReDim rij(1 To dimensie)
    ReDim tmpreeks(1 To regels, 1 To kolommen)
    For r = 1 To regels
        For k = 1 To kolommen
            'alleen ter illustratie
            tmpreeks(r, k) = reeks(r, k).Value
            'hier vindt de omzetting van reeks naar rij plaats
            rij((r - 1) * kolommen + k) = tmpreeks(r, k)
        Next k
    Next r
    
    'alleen voor test-doeleinden
    For i = 1 To dimensie
        Debug.Print i & ": " & rij(i)
    Next i
End Sub

Meestal zal u de variabele reeks als parameter in de Sub opnemen. De declaratie wordt dan: Sub Reeks2Rij(ByVal reeks as Range).

Wanneer u in code de dimensie wilt bepalen van een multidimensionale array dan gebruikt u de functie UBound met een tweede parameter. De tweede parameter geeft de dimensie aan. Dus de expressie UBound(reeks , 2) geeft aan tot hoever de tweede dimensie van reeks loopt.

Naar boven