Tworzenie linii kodu makrem z dodatku
by vbatools 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.
June 25th, 2020 on 20:07
Fajny kod i przydatny, wymaga niestety (prawdopodobnie) włączonego w ustawieniach u klienta “Dostępu do modelu obiektowego”
June 25th, 2020 on 20:50
Ja mam zawsze tą opcję włączoną, a w moich gotowych rozwiązaniach włączam ją przez ustawienie rejestru. 🙂