VBATools

Tworzenie linii kodu makrem z dodatku

by on Jul.21, 2011, under Excel, Porady

Zwykle, pisanie kodu polega na umieszczeniu przez programistę procedur w środowisku developerskim danego pliku lub dodatku. Czasami jednak zachodzi konieczność modyfikacji czy rozbudowania istniejącego (wcześniej wydanego) programu. Przypadkiem jest aplikacja, która została już opublikowana, ale sytuacja wymaga wykonania poprawki bez bezpośredniego dostępu do oryginału.

Poniższy przykład tworzy moduł i osadza w nim kod, dodatkowo tworzy formę z przyciskami i podobnie jak w module osadza procedurę w formie. Można go osadzić w dodatku, który zmodyfikuje opisywaną aplikacje.

Private Sub NewModule()
Dim NewMod As Object
'MVP OShon from VBATools.pl
Set NewMod = ThisWorkbook.VBProject.VBComponents.Add(1)
NewMod.Name = "nowy_modul"
Set NewMod = ThisWorkbook.VBProject.VBComponents(NewMod.Name)
 With NewMod.CodeModule
 .InsertLines 2, _
 "Public Sub Kod_robiacy_cos()" & Chr(13) & _
 "MsgBox " & Chr(34) & "Komunikat wygenerowany z modułu!" & Chr(34) & _
 ", vbExclamation, " & Chr(34) & _
 "VBATools.pl" & Chr(34) & Chr(13) & _
 "End Sub"
 End With
Set NewMod = Nothing

Dim NewForm As Object
Set NewForm = ThisWorkbook.VBProject.VBComponents.Add(3)
 NewForm.Properties("Width") = 120
 NewForm.Properties("Height") = 100
 NewForm.Properties("Caption") = "VBATools.pl"

 Dim NewButton As Object
 Set NewButton = NewForm.Designer.Controls.Add("Forms.CommandButton.1")
 With NewButton
 .Width = 96
 .Height = 18
 .Left = 12
 .Top = 12
 .Caption = "Komunikat z modułu"
 .Name = "Przycisk"
 End With
 Set NewButton = NewForm.Designer.Controls.Add("Forms.CommandButton.1")
 With NewButton
 .Width = 96
 .Height = 18
 .Left = 12
 .Top = 42
 .Caption = "Komunikat z formy"
 .Name = "Przycisk2"
 End With

 With NewForm.CodeModule
 .InsertLines 2, _
 "Private sub Przycisk_Click()" & Chr(13) & _
 "Call Kod_robiacy_cos" & Chr(13) & _
 "End Sub" & Chr(13) & Chr(13) & _
 "Private sub Przycisk2_Click()" & Chr(13) & _
 "Msgbox " & Chr(34) & "Komuniat wygenerowany z formy." & Chr(34) & _
 ", vbInformation, " & Chr(34) & _
 "VBATools.pl" & Chr(34) & Chr(13) & _
 "End Sub"
 End With

Set NewButton = Nothing
Set NewForm = Nothing
End Sub

W niektórych przypadkach musimy dodać kod do modułu arkusza. W tym przypadku musimy odwołać się do nazwy kodowej arkusza a nie do nadanej w “zakładce”.

Poniższy przykład pokazuje jak do aktywnego arkusza dodać kontrolkę image i jak następnie podłączyć do niej procedurę, którą użytkownik wykorzysta jako mechanizm dodawania dowolnego obrazu.

'dodanie kontrolki
ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", _ 
Left:=505, Top:=55, Width:=305, Height:=290).Select
'MVP OShon from VBATools.pl
'dodanie procedury do modułu arkusza
Dim code$ 
 code = "Private Sub Image1_Click()" & vbCrLf 
 code = code & "Dim Filt$, FilterIndex As Integer" & vbCrLf 
 code = code & "    Dim Filename As Variant" & vbCrLf 

 code = code & "    Filt = ""Pliki bitmapy (*.bmp),*.bmp,"" & _" & vbCrLf 
 code = code & "           ""Pliki skompresowane (*.jpg),*.jpg,"" & _" & vbCrLf 
 code = code & "           ""Wszystkie pliki (*.*),*.*""" & vbCrLf 
 code = code & "    FilterIndex = 2" & vbCrLf 

 code = code & "    Filename = Application.GetOpenFilename( _" & vbCrLf 
 code = code & "        FileFilter:=Filt, _" & vbCrLf 
 code = code & "        FilterIndex:=FilterIndex, _" & vbCrLf 
 code = code & "         Title:=""Wybierz obraz"")" & vbCrLf 

 code = code & "    If Filename = False Then" & vbCrLf 
 code = code & "        MsgBox ""Nie wybrano pliku!"", vbExclamation, _" & vbCrLf 
 code = code & "               ""Informacja o błędzie""" & vbCrLf 
 code = code & "        Exit Sub" & vbCrLf 
 code = code & "    End If" & vbCrLf 
 code = code & "  Image1.Picture = LoadPicture(Filename)" & vbCrLf 
 code = code & "End Sub" 

 Dim CurSheet As Worksheet 
 Set CurSheet = ActiveSheet 
 With ThisWorkbook.VBProject.VBComponents(CurSheet.CodeName).CodeModule 
 .InsertLines .CountOfLines + 1, code 
 End With 
 Set CurSheet = Nothing

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.
:, , , , , ,

2 Comments for this entry

Leave a Reply