kelly mort
Well-known Member
- Joined
- Apr 10, 2017
- Messages
- 2,169
- Office Version
- 2016
- Platform
- Windows
Hello Geniuses,
I have this challenge here and I need you all to help me nail it down.
I want to do something cooler with a userform by clicking a button which will open a dialogue box where I choose the picture I wanna upload. I started this and suspended for a while and wanna get buck to it again.
Now here is the actual challenge:
I want to have these buttons : add data, delete data, edit data on the form. I will need also a listbox so that the edit and delete will be possible.
So when I upload the image and send the data to the database, the image should be asigned to the item in a textbox called Reg1 which contains an ID.
So if I want to edit , it should be possible for me to also change the image if I want to and this then should override the old image.
Then when I delete the data too, that image and its ID must be deleted too.
It sounds like impossible to me but I have the feeling there are bigger brains here who can adapt to this for me.
So far, I have this code which I got from @MickG some time ago when I was not really sure what I wanted to achieve. But now the picture is clear, what I want.
I have this challenge here and I need you all to help me nail it down.
I want to do something cooler with a userform by clicking a button which will open a dialogue box where I choose the picture I wanna upload. I started this and suspended for a while and wanna get buck to it again.
Now here is the actual challenge:
I want to have these buttons : add data, delete data, edit data on the form. I will need also a listbox so that the edit and delete will be possible.
So when I upload the image and send the data to the database, the image should be asigned to the item in a textbox called Reg1 which contains an ID.
So if I want to edit , it should be possible for me to also change the image if I want to and this then should override the old image.
Then when I delete the data too, that image and its ID must be deleted too.
It sounds like impossible to me but I have the feeling there are bigger brains here who can adapt to this for me.
So far, I have this code which I got from @MickG some time ago when I was not really sure what I wanted to achieve. But now the picture is clear, what I want.
Rich (BB code):
Option Explicit
Dim Dic As Object
Private Sub ComboBox1_Change()
Me.Image1.Picture = LoadPicture(Dic(ComboBox1.Value))
Image1.PictureSizeMode = fmPictureSizeModeStretch
ActiveSheet.Image1.Picture = LoadPicture(Dic(ComboBox1.Value))
End Sub
Private Sub CommandButton1_Click()
Dim Fd As Office.FileDialog
Dim txtFileName As String
Set Fd = Application.FileDialog(msoFileDialogFilePicker)
With Fd
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select the file."
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1
' .Filters.Add "Excel 2003", "*.xls"
'.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
Call AddPth(txtFileName)
End If
Me.Image1.Picture = LoadPicture(txtFileName)
Image1.PictureSizeMode = fmPictureSizeModeStretch
ActiveSheet.Image1.Picture = LoadPicture(txtFileName)
End With
End Sub
Sub AddPth(pth)
Dim TextFile As Integer, Dn As Range, Fd As Boolean, Filecontents As String
Dim FilePath As String, Filecontent As String
'What is the file path and name for the new text file?
FilePath = ThisWorkbook.Path & "\nDoc.txt"
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
If Not FileExists(FilePath) Then 'new line
Open FilePath For Output As TextFile
Print #TextFile , pth
Else
Open FilePath For Input As TextFile
Filecontent = Input(LOF(TextFile), TextFile)
If InStr(Filecontent, pth) = 0 Then
Close TextFile
Open FilePath For Append As TextFile
Print #TextFile , pth
End If
End If
'Store file content inside a variable
Close TextFile
Call Checkpics
End Sub
Sub Checkpics()
Dim Sp As Variant, S As Variant, K As Variant, Temp As String
Dim TextFile As Integer, FilePath As String, Filecontent As String
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
FilePath = ThisWorkbook.Path & "\nDoc.txt"
If Not FileExists(FilePath) Then Exit Sub
'File Path of Text File
FilePath = ThisWorkbook.Path & "\nDoc.txt"
'Determine the next file number available for use by the FileOpen function
TextFile = FreeFile
'Open the text file
Open FilePath For Input As TextFile
'Store file content inside a variable
Filecontent = Input(LOF(TextFile), TextFile)
Sp = Split(Filecontent, vbCrLf)
Dim c As Long
c = 2000
For Each S In Sp
If Not S = "" Then
c = c + 1
Dic.Item("WK" & c) = S
Temp = "WK" & c
End If
Next S
With ComboBox1
.Clear
.List = Dic.keys
Range("A1").Value = Temp
End With
'Delete File
Close TextFile
Kill FilePath
Open FilePath For Output As TextFile
For Each K In Dic.keys
Print #TextFile , Dic(K)
Next K
Close TextFile
End Sub
Public Function FileExists(ByVal FileName As String) As Boolean
Dim Attr As Long
On Error Resume Next
Attr = GetAttr(FileName)
FileExists = (Err.Number = 0) And ((Attr And vbDirectory) = 0)
On Error GoTo 0
End Function
Private Sub Reg1_Change()
Dim n As Long
With ComboBox1
For n = 0 To .LineCount - 1
If .List(n) = Me.Reg1.Value Then .Value = .List(n)
Next n
End With
End Sub
Private Sub UserForm_Initialize()
Call Checkpics
End Sub
