not sure how do phrase this question but I really dont understand it.
I want to achieve the following:
TextBox = TextVorname
TextBox = TextNachname
For Example I put in the 1. Textbox "Markus"
and put in the 2. Textbox "Neumann"
I want it to display in the Bookmark "Ma.Ne_2022"
I have following Code:
Private Sub OptionButton1_Click()
Dim VornameStr As String
VornameStr = Me.TextVorname.Caption
Dim NachnameStr As String
NachnameStr = Me.TextNachname.Caption
MyStrVorname = Left(VornameStr, 2)
MyStrNachname = Left(NachnameStr, 2)
MyStrFullname = MyStrVorname & "." & MyStrNachname & "_2022"
Call UpdateBookmark("test1", Me.MyStrFullname.Caption)
End Sub
Your question is a little bit vague.. Maybe this is what you're after?
Dim MyVornameStr As String
Dim MyNachnameStr As String
Dim MyStrFullname As String
MyStrVorname = Left(Me.TextVorName.Text, 2)
MyStrNachname = Left(Me.TextNachName.Text, 2)
MyStrFullname = MyStrVorname & "." & MyStrNachname & "_2022"
Call UpdateBookmark("test1", MyStrFullname)
Related
I've made a real estate related worksheet that includes a few cells for the property's address and a picture of a Google Maps view of the property. I want to be able to change the address in the worksheet and then click the image to have it refresh with a map of the new address. I can't figure out how to replace the image.
Here's what I've got so far:
Function scrub(s As String)
scrub = Replace(s, " ", "+")
scrub = Replace(scrub, ",", "")
End Function
Function GetImageAddress(rng As Range)
Dim cell As Range
Dim addressString As String
addressString = ""
For Each cell In rng
If cell.Value <> "" Then
If addressString <> "" Then
addressString = addressString & "+" & scrub(cell.Value)
Else
addressString = scrub(cell.Value)
End If
End If
Next cell
Dim urlstart, urlmid, urlend, key As String
key = "API_KEY" 'you'll need to get your own Google API Key for this to work
urlstart = "https://maps.googleapis.com/maps/api/staticmap?center="
urlmid = "&markers=color:0x359BB2%7C"
urlend = "&zoom=17&size=640x480&scale=3&maptype=hybrid&key=" & key
GetImageAddress = urlstart & addressString & urlmid & addressString & urlend
End Function
Sub fetchImage()
Dim rng As Range
Set rng = ActiveSheet.Range("E10:E12")
Dim url As String
url = GetImageAddress(rng)
Dim myImage As Shape
Set myImage = ActiveSheet.Shapes("Map")
'something should go here to replace myImage with a new downloaded picture.
End Sub
Use the .Fill.UserPicture property
myImage.Fill.UserPicture url
Here is an example
Option Explicit
Sub Sample()
Dim url As String
Dim myImage As Shape
url = "https://lh4.googleusercontent.com/-X3sAhOMOHzs/AAAAAAAAAAI/AAAAAAAADMM/dTqQjEqFDm4/photo.jpg?sz=32"
Set myImage = ActiveSheet.Shapes(1)
myImage.Fill.UserPicture url
End Sub
will fill the shape with your stackoverflow DP.
Note: This won't work if the original shape was an inserted picture. Insert a new shape like a rectangle, and then this will work.
I have declared constants like the below in the module,
Public Const strFolderA1 = "C:\ABCD\One"
Public Const strFolderA2 = "C:\ABCD\two"
I am trying to call this in a loop,
For i = 1 To 3
strFile = Dir(strFolderA & i & "\" & filenm)
Loop
The above Dir code is wrong, but I want to call the constant based on the looping integer.
Could someone help?
Please let me know if the question is not clear.
VBA does not provide any method for concatenating a string to be used as a dynamic variable name. You could create a string constant with a delimiter then split it before use.
Option Explicit
Public Const strFolderA As String = "C:\ABCD\One|C:\ABCD\Two|C:\ABCD\Three"
Sub abcs()
Dim i As Long, fldrs As Variant
fldrs = Split(strFolderA, "|")
For i = LBound(fldrs) To UBound(fldrs)
Debug.Print fldrs(i)
Next i
End Sub
I have a column in a spreadsheet.
The format of the data in each cell is aa-0001-xx.
I need to examine the whole column to find the highest value of the sequence number. this would be the substring from column4 thru column7.
I can find the sequence number using Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4)
But I need to find the max sequence in the whole column.
I am doing this in VBA.
Any help would be appreciated.
Here is my code so far:
Private Sub CommandButton1_Click()
Dim sQuoteNumber As String
Dim sFileName As String
Dim sPathName As String
Dim checkit As String
'Log the Quote
'First, open the log file and determine the next sequential log number.
sPathName = "C:\Users\Rich\Documents\Bryan\BigProject\"
sFileName = "QuoteLog2016.xlsx"
ControlFile = ActiveWorkbook.Name
Workbooks.Open Filename:=sPathName & sFileName
'Create the new Quote Number
checkit = Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) ' This is a temp test line
If Mid(ActiveWorkbook.Sheets("Sheet1").Range("B2:B2"), 4, 4) = "" Then
sQuoteNumber = "16-0001"
Else
'find the biggest number
'Here I was looking to like pass the mid function to a Max function of some sort.
sQuoteNumber = "16-0002"
End If
MsgBox ("The new Quote Number is: " + sQuoteNumber)
'Save the log entry
Workbooks(sFileName).Close
All of the comments made to your answer would work well for you. It's also true that there's no evidence in your code at having attempted something, however rudimentary, and this is why answers to a rather trivial task are not forthcoming for you. Perhaps, in future, have a go at some kind of solution ( even if it feels more guesswork than anything) and people on this site will be much more supportive of you.
To set you on your way, you could make use of the Split() function which converts a String into a String array, separated by a nominated value - in the case of your quotations, you could use "-" as your separator. This might be easier than your Mid function and will deal with the case of different sized quotations.
The code below will get you started but you'd want some error handling in there to test, for example, that each cell splits appropriately or that any cells aren't blank. I'll leave all of that to you.
Option Explicit
Private mLastQuote As Long
Public Sub Test()
Initialise 'call this routine just once at the start of your project
MsgBox GetNextQuote(16) 'use the GetNextQuote() function to get next number
MsgBox GetNextQuote(16)
MsgBox GetNextQuote(16)
End Sub
Private Function GetNextQuote(prefix As Integer) As String
mLastQuote = mLastQuote + 1
GetNextQuote = CStr(prefix) & "-" & _
Format(mLastQuote, "000#")
End Function
Private Sub Initialise()
Const PATH_NAME As String = "C:\Users\Rich\Documents\Bryan\BigProject\"
Const FILE_NAME As String = "QuoteLog2016.xlsx"
Const QUOTE_COL As String = "B"
Dim wb As Workbook
Dim ws As Worksheet
Dim v As Variant
Dim r As Long
Dim parts() As String
Dim num As Long
Application.ScreenUpdating = False
Set wb = Workbooks.Open(PATH_NAME & FILE_NAME, True, True)
Set ws = wb.Worksheets("Sheet1")
'Read quote values into variant array
With ws
v = .Range(.Cells(2, QUOTE_COL), _
.Cells(.Rows.Count, QUOTE_COL).End(xlUp)) _
.Value2
End With
'Find max quote
For r = 1 To UBound(v, 1)
parts = Split(v(r, 1), "-") 'splits quote into 3 parts
num = CLng(parts(1)) 'index (1) is the middle part
If num > mLastQuote Then mLastQuote = num
Next
wb.Close False
Application.ScreenUpdating = True
End Sub
Following is the statement
Performance;#Recruiting;#Culture and values;#Community Involvement &
Volunteerism;/Talent Development;#Workplace
I want each value present after the ;# sign to be paste in a new cell? How do i do it?
I've not used VBA for some time, but this should get you started at least:
Private Sub ProcessStr()
Dim strTest As String
Dim strArray() As String
Dim i As Integer
strTest = "YOUR STRING"
strArray = Split(strTest, ";")
For i = LBound(strArray) To UBound(strArray)
// REMOVE # SIGN HERE ?
// DO SOMETHING WITH THE VALUES
// strArray(i) - CONTAINS EACH VALUE
// PLACE IN INDIVIDUAL CELLS
Next
End Sub
Hope this helps!
dim arrString() as string
dim strInput as string
dim i as integer
strInput = "Performance;#Recruiting;#Culture and values;#Community Involvement &
Volunteerism;/Talent Development;#Workplace"
arrStrings = strings.split(strInput, ";#")
for i = 1 to ubound(arrstrings)
cells(i, 1) = arrstrings(i)
next i
I've built a userform that allows modification of a macro-generated string before it becomes part of a new spreadsheet. As written, I have one worry about how resilient it will be.
The form has a single textbox called CourseDescription into which a string value strBundleDescription is dumped:
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
The user can then edit the text as needed and press OK to pass the text to the spreadsheet being created.
On clicking OK, the modified string is placed in Range("B7") of the spreadsheet:
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
Range("B7").Value = strValue
End If
Unload Me
End Sub
This works so far in practice, but I've had unexplained focus issues before. I am concerned that the focus might in some (unknown) circumstance shift to another open worksheet and the text will be pasted where it does not belong.
My question: Am I right to want a more defined location, or will a simple range definition like the one above be adequate? And if a more defined location is advised, is there a way to pass information like the wkbSaba and shtCourse values without making public variables?
All potential solutions I found involved some form of public variable, but on principle (rightly or wrongly) I'm trying to avoid public variables when information will only be used in one function (as in this case).
Full Code, as requested: This is the the full macro code as it stands. The call for frmDescriptionReview is about 3/4 of the way down under the comment tag "'enter base information for Bundle Description".
I'm going to try the Property call as you suggest, which is something I did not know about, and had not seen when web searching for ways to pass data to a userform. So much to learn! It certainly looks like the variables could be passed that way.
Option Explicit
Sub TransferData()
'***************************************
' TO USE THIS MACRO:
' 1. Make sure that all information for the bundle is included
' on the 'km notification plan' and 'bundle details (kbar)' tabs
' of the Reporting_KMFramework.xlsx
' 2. Select the bundle name on the 'km notification plan' tab.
' 3. Start the macro and it should create the basis of the Saba
' form
' 4. Read through the entire form, especially the bundle
' description, to be sure it is complete and accurate.
'***************************************
'establish variables
Dim iRow As Integer
Dim sTxt As String
Dim sTxt2 As String
Dim sBundleName As String
Dim sNumber As String
Dim aSplit() As String
Dim aSplit2() As String
Dim aBundleSplit() As String
Dim aNumberSplit() As String
Dim wkbFramework As Workbook
Dim wkbSaba As Workbook
Dim shtPlan As Worksheet
Dim shtCourse As Worksheet
Dim vData As Variant
Dim vBundleName As Variant
Dim lLoop As Long
'set initial values for variables
'find current row number
iRow = ActiveCell.Row
'remember locations of current data
Set wkbFramework = ActiveWorkbook
Set shtPlan = ActiveSheet
'Set rngSelect = Range("B" & iRow)
'select bundle name
vBundleName = shtPlan.Range("B" & iRow).Value
vData = vBundleName
sBundleName = shtPlan.Range("B" & iRow).Value
'find and save course names for the bundle
Sheets(2).Select
sTxt = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 1).Value 'course names from Detail tab
sTxt2 = Find_Range(vBundleName, Columns("B"), xlValues).Offset(0, 2).Value 'course numbers from Detail tab
'open new Saba Form
Workbooks.Add Template:= _
"C:\Documents and Settings\rookek\Application Data\Microsoft\Templates\Bundle_SabaEntryForm_KM.xltm"
'remember locations of Saba form
Set wkbSaba = ActiveWorkbook
Set shtCourse = ActiveSheet
'move data into new Saba form
'paste bundle name
wkbSaba.Sheets(shtCourse.Name).Range("B5").Value = vData
'Transfer bundle number
vData = wkbFramework.Sheets(shtPlan.Name).Range("E" & iRow).Value
sNumber = vData
Dim aNumber() As String
aNumber = Split(sNumber, "-")
wkbSaba.Sheets(shtCourse.Name).Range("B6").Value = vData
'create names to use in the bundle description and (later) in naming the file
'Establish additional variables
Dim strDate As String
Dim strName1 As String
Dim strName2 As String
Dim strName3 As String
Dim strName4 As String
Dim strName5 As String
Dim aTechSplit() As String
Dim aCourse() As String
Dim iTech As Integer
'Dim iBundle As Integer
Dim iCourse As Integer
vData = wkbFramework.Sheets(shtPlan.Name).Range("L" & iRow).Value
aCourse = Split(sTxt, Chr(10))
iCourse = UBound(aCourse)
aTechSplit = Split(vData, " ")
iTech = UBound(aTechSplit)
aBundleSplit = Split(sBundleName, " ")
aNumberSplit = Split(sNumber, "-")
strName1 = aBundleSplit(0)
strName2 = aBundleSplit(1)
If UBound(aNumberSplit) > 1 Then
strName3 = aNumberSplit(UBound(aNumberSplit) - 1) & aNumberSplit(UBound(aNumberSplit))
End If
strName3 = Right(strName3, Len(strName3) - 1)
strName4 = aTechSplit(0) & " "
strName5 = aCourse(0)
For lLoop = 1 To iTech - 1
strName4 = strName4 & aTechSplit(lLoop) & " "
Next lLoop
If iCourse > 1 Then
For lLoop = 1 To iCourse - 1
strName5 = strName5 & ", " & aCourse(lLoop)
Next lLoop
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
If iCourse = 1 Then
strName5 = strName5 & ", and " & aCourse(iCourse)
End If
strName5 = Replace(strName5, " Technical Differences", "")
strName5 = Replace(strName5, " Overview", "")
strName5 = Replace(strName5, " Technical Presales for ATCs", "")
strName5 = Replace(strName5, " Technical Presales for STCs", "")
strName5 = Replace(strName5, " Technical Presales", "")
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
'transfer tech and track
wkbSaba.Sheets(shtCourse.Name).Range("B8").Value = vData
'transfer product GA date
vData = wkbFramework.Sheets(shtPlan.Name).Range("G" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B9").Value = vData
'transfer bundle notification date
vData = wkbFramework.Sheets(shtPlan.Name).Range("D" & iRow).Value
wkbSaba.Sheets(shtCourse.Name).Range("B10").Value = vData
'set audience type
If aNumber(UBound(aNumber)) = "SA" Then
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner, Customer"
Else
wkbSaba.Sheets(shtCourse.Name).Range("B11").Value = "Internal, Partner"
End If
'set Education Manager
frmEducationManagerEntry.EducationManagers.MultiLine = True
frmEducationManagerEntry.EducationManagers.WordWrap = True
frmEducationManagerEntry.Show
'set EPG
wkbSaba.Sheets(shtCourse.Name).Range("B13").Value = "N/A (KM course reuse)"
'set Test information to N/A
wkbSaba.Sheets(shtCourse.Name).Range("A22:B22").Value = "N/A"
'enter course names
aSplit = Split(sTxt, Chr(10)) 'if there is more than one course, this establishes a number and location for each
If UBound(aSplit) > 4 Then
'add rows equal to the difference between ubound and 5
wkbSaba.Sheets(shtCourse.Name).Range("A21", "B" & 21 + (UBound(aSplit) - 5)).Select
Selection.EntireRow.Insert
End If
For lLoop = 0 To UBound(aSplit)
wkbSaba.Sheets(shtCourse.Name).Range("B" & 17 + lLoop).Value = aSplit(lLoop)
Next lLoop
'enter course numbers
aSplit2 = Split(sTxt2, Chr(10)) 'if there is more than one course, this establishes a number and location for each
For lLoop = 0 To UBound(aSplit2)
wkbSaba.Sheets(shtCourse.Name).Range("A" & 17 + lLoop).Value = Trim(aSplit2(lLoop))
Next lLoop
'save and close Saba form
With wkbSaba.Sheets(shtCourse.Name)
Dim SaveAsDialog As FileDialog
strDate = Date
strDate = Replace(strDate, "/", ".")
Set SaveAsDialog = Application.FileDialog(msoFileDialogSaveAs)
With SaveAsDialog
.Title = "Choose a file location and file name for your new Saba form"
.AllowMultiSelect = False
.InitialFileName = strName1 & strName2 & "_SabaEntryForm_" & strName3 & ".xlsx"
'.InitialFileName = sSavelocation & "\" & strName3 & "\" & aBundleSplit(0) & aBundleSplit(1) & "_" & strName3 & "_SabaEntryForm" & ".xlsx"
.Show
.Execute
End With
wkbSaba.Sheets(shtCourse.Name).PrintOut
wkbSaba.Close
End With
' Return focus to Plan sheet
shtPlan.Activate
End Sub
Addition of Property code fails
I tried adding code based on the property link shared in the comments, but running the code results in a Compile error: Method or data member not found. The complete userform code looks like this:
Option Explicit
Private wkbLocation As Workbook
Private shtLocation As Worksheet
Private Sub cmdCancel_Click()
Unload Me
End
End Sub
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wkbLocation.Sheets(shtLocation).Range("B7").Value = strValue
End If
Unload Me
End Sub
Property Let MyProp(wkbSaba As Workbook, shtCourse As Worksheet)
wkbLocation = wkbSaba
shtLocation = shtCourse
End Property
And the call for the userform now looks like this:
'enter base information for Bundle Description
Dim strBundleDescription As String
strBundleDescription = "This Knowledge Maintenance bundle covers recent technology changes that may affect " & strName4 & "environments. Topics covered by this bundle include the enhancements and features introduced with " & strName5 & "."
'wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
Dim frmDescriptionReview As UserForm3
Set frmDescriptionReview = New UserForm3
frmDescriptionReview.MyProp = "Pass to form"
frmDescriptionReview.CourseDescription = strBundleDescription
frmDescriptionReview.CourseDescription.MultiLine = True
frmDescriptionReview.CourseDescription.WordWrap = True
frmDescriptionReview.Show
When I run the code, I get a Compile error: Method or data member not found, highlighting .MyProp. Help says this error means I misspelled the object or member name, or specified a collection index that is out of range. I checked the spelling, and MyProp is exactly how I spelled it in both locations. I don't think I'm specifying a collection am I? None are explicitly defined. What am i doing wrong?
I am concerned that the focus might in some (unknown) circumstance
shift to another open worksheet and the text will be pasted where it
does not belong.
Not really sure what you are asking. But you can further define your range variable by using:
Workbooks("Book1.xlsm").Worksheets("Sheet1").Range("B7").Value = strValue
or
Workbooks(wkbSaba).Worksheets(shtCourse).Range("B7").Value = strValue
That will ensure it goes to the right workbook and worksheet. I'm not sure why you think you need public variables?
EDIT:
UserForm Code:
Private wsSheet As Worksheet
Property Let SetWorksheet(wsSheetPass As Worksheet)
Set wsSheet = wsSheetPass
End Property
Private Sub cmdOK_Click()
Dim strValue As String
strValue = CourseDescription.Value
If strValue <> "" Then
wsSheet.Range("B7").Value = strValue
End If
Unload Me
End Sub
Calling Module:
Dim wsSheetToPass As Worksheet
Set wsSheetToPass = Workbooks(wkbSaba).Worksheets(shtCourse)
frmDescriptionReview.SetWorksheet = wsSheetToPass
As Reafidy states, creating a Property for the Userform and passing information to it would clearly be the right answer for passing variables to and from a userform.
Ideally what I want is to have the form very losely coupled with the module, and not touch the spreadsheet at all (so when appropriate I can pass information to the form from other modules, get the information returned, and place it where appropriate for the current module (which could be on an entirely different spreadsheet or in a completely different cell).
I found additional information on passing data with properties on the PeltierTech web site (http://peltiertech.com/Excel/PropertyProcedures.html) that helped me understand what Reafidy was doing so I couls start loosening the coupling between my code and my forms even more (which was my original intent for this question.
Adding the Get property allows the loose coupling I'm looking for, allowing me to both give and receive information without having to pass the spreadsheet data at all. So my call in the module now looks like this:
'review and revise Description Text
Dim DescriptionReview As New frmDescriptionReview
With DescriptionReview
.Description = strBundleDescription
.Show
strBundleDescription = .Description
End With
Unload DescriptionReview
'transfer description text
wkbSaba.Sheets(shtCourse.Name).Range("B7").Value = strBundleDescription
and the code for the UserForm itself becomes much simpler, like this:
Option Explicit
Property Let Description(ByVal TextBeingPassed As String)
Me.CourseDescription.Value = TextBeingPassed
End Property
Property Get Description() As String
Description = Me.CourseDescription.Value
End Property
Private Sub cmdOK_Click()
Me.Hide
End Sub
Private Sub cmdCancel_Click()
Unload Me
End
End Sub