Tulostinystävällinen sivu

Löydät tältä sivulta muutamia esimerkkimakroja Exceliin. Voit ladata esimerkkimakrot valmiina apuohjelmana (AddIn) tai kopioida alla olevan koodin Visual Basic editorissa jonkin moduulin sisään.

AddInin asentamisen jälkeen alla olevat makrot ovat aina käytettävissä.

Ulkoisten linkkien etsimiseen tarkoitettu makro on mukaelma täällä esitetystä koodista: http://www.exceltip.com/st/List,_change_or_delete_external_formula_refer...

Option Explicit

' vaihtelee solun kirjainkokoa 3 eri tilan välillä
Sub muutaKirjainkoko()

    Dim c As Range
    Dim str As String
   
    On Error Resume Next
   
    For Each c In Selection
   
        str = c.Value
       
        If str = LCase(str) Then
            ' Hyödynnetään Proper-laskentataulukkofunktiota
            str = WorksheetFunction.Proper(str)
        ElseIf str = WorksheetFunction.Proper(str) Then
            str = UCase(str)
        Else
            str = LCase(str)
        End If
       
        c.Value = str
    Next c
End Sub

Sub poistaUloimmatMerkit()
    Dim cell As Range
   
    On Error Resume Next
    For Each cell In Selection
        cell.Value = Mid(cell.Value, 2, Len(cell.Value) - 2)
    Next cell
End Sub

' Etsii työkirjan sisältämät viittaukset ulkoisiin työkirjoihin
Sub EtsiLinkit()

    Dim etsiTaalta As Worksheet
    Dim linkkiLuettelo As Worksheet
   
    ' Virheen sattuessa siirrytään virheidenkäsittelijään
    On Error GoTo ErrHandler
  
    ' Luodaan listaus viittauksista Linkkiluettelo -nimiseen laskentataulukkoon
    Set linkkiLuettelo = Sheets("Linkkiluettelo")
   
    ' Tyhjennetään mahdolliset vanhat linkit Linkkiluettelo -laskentataulukosta
    With linkkiLuettelo
        .UsedRange.Clear
        .Range("A1").Value = "Työkirjan " & linkkiLuettelo.Parent.Name & " sisältämät linkit "
        .Range("A1").Font.Bold = True
    End With
   
    ' Kirjoitetaan tilariville
    Application.StatusBar = "Etsitään ulkoisia viittauksia..."
   
    For Each etsiTaalta In Worksheets
        ListLinksInWS etsiTaalta, linkkiLuettelo
    Next etsiTaalta
   
    ' Tyhjennetään tilarivi
    Application.StatusBar = False

    ' Siirretään käyttäjä Linkkiluettelo -laskentataulukkoon
    linkkiLuettelo.Activate
    Exit Sub
ErrHandler:
    Worksheets.Add.Name = "Linkkiluettelo"
    Resume
End Sub

' Etsii linkit, ei huomioi soluja joissa esim. '=[
Private Sub ListLinksInWS(ByVal ws As Worksheet, ByVal TargetWs As Worksheet)

    Dim cl As Range, cFormula As String, tRow As Long
   
    If ws Is Nothing Then Exit Sub
    If TargetWs Is Nothing Then Exit Sub
  
    For Each cl In ws.UsedRange
        cFormula = cl.Formula
        If Len(cFormula) > 0 Then
            If Left(cFormula, 1) = "=" Then
                If InStr(cFormula, "[") > 1 Then
                    With TargetWs
                        tRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                        .Range("A" & tRow).Formula = tRow - 1
                        .Range("B" & tRow).Formula = ws.Name & "!" & _
                            cl.Address(False, False)
                        .Range("C" & tRow).Formula = "'" & cFormula
                    End With
                End If
            End If
        End If
    Next cl
   
    Set cl = Nothing
End Sub

' palauttaa viimeisen muokatun solun usedRangen viimeiseksi soluksi
Sub updateXlLastCell()
    ActiveSheet.UsedRange
End Sub