I've got a Macro that I run that writes a copyright header to my document. Currently when the header is written, the cursor is left at the end of the header.
What I'd like to be able to do is capture the current location, write the header, and then return the cursor to the original location.
Does anyone know how this can be accomplished?
I think I've got it.
Dim selection As TextSelection = DTE.ActiveDocument.Selection
''# store the original selection and cursor position
Dim topPoint As TextPoint = selection.TopPoint
Dim bottomPoint As TextPoint = selection.BottomPoint
Dim lTopLine As Long = topPoint.Line
Dim lTopColumn As Long = topPoint.LineCharOffset
Dim lBottomLine As Long = bottomPoint.Line
Dim lBottomColumn As Long = bottomPoint.LineCharOffset()
Dim verticalOffset As Integer = 0
''# do a bunch of stuff that adds text to the page
''# Restore cursor to previous position
selection.MoveToLineAndOffset(lBottomLine + verticalOffset, lBottomColumn)
selection.MoveToLineAndOffset(lTopLine + verticalOffset, lTopColumn, True)
This is all nested within a Macro I wrote to automatically add a copyright header to each code file.
Related
I have the following code:
Sub YYY()
Dim rCell As Range
Dim lColor As Long
Dim rColored As Range
lColor = vbYellow
Set rColored = Nothing
For Each rCell In Selection
I would like to change it that it will check it without selection (automatically)
meaning, that in every dynamic workbook it will return if there are or aren't yellow cells
thanks in advance!
I have working macro for switching mouse cursor to pen tool and back to cursor.
Now the problem is, that after I have done my drawing with pen tool, I use macro to export that page to .pdf and after that quit slideshow with
ActivePresentation.SlideShowWindow.View.Exit
and after pressing macro button PP ask if I want to Keep or Discard my drawing. After pressing Keep, slideshow shut down, new pdf file is created, but drawing doesn't get to in. If I export that page again, then it shows up. So it seems it creates .pdf first and after that saves the drwaing.
So is there a way to save drawing before exiting slideshow? It is fine if drawing is not there after leaving slideshow, but I want it to be in .pdf after first click.
Current macro for pdf export is
Sub convert_to_PDF()
Dim timestamp As Date
Dim PR As PrintRanges
Dim lngLast As Long
Dim lngFirst As Long
Dim savePath As String
Dim PrintPDF As Integer
Dim name As String
Dim originalHides() As Long
Dim slidesToPrint() As Variant
Dim i As Variant
timestamp = Now()
With ActivePresentation
name = .Slides(2).Shapes("TextBox1").OLEFormat.object.Text
savePath = "C:\Powerpoint\" & Format(timestamp, "yyyymmdd-hhnn") & " - " & name & ".pdf"
lngLast = .Slides.Count
.PrintOptions.Ranges.ClearAll
slidesToPrint = Array(2, lngLast)
ReDim originalHides(1 To lngLast)
For i = 1 To lngLast
originalHides(i) = .Slides(i).SlideShowTransition.Hidden
.Slides(i).SlideShowTransition.Hidden = -1
Next
For Each i In slidesToPrint()
.Slides(i).SlideShowTransition.Hidden = 0
Next
.ExportAsFixedFormat _
Path:=savePath, _
FixedFormatType:=ppFixedFormatTypePDF, _
Intent:=ppFixedFormatIntentScreen, _
FrameSlides:=msoTrue
For i = 1 To lngLast
.Slides(i).SlideShowTransition.Hidden = originalHides(i)
Next
EraseInkOnSlide ActivePresentation.Slides(lngLast)
End With
End Sub
I am attempting to 'save' the context of a text box in vb6 to a *.ini file, so that it can be used in a later part of the program. (i.e. the user would enter something into the text box, then later in the program, a label would appear with the user-entered, saved information).
I used the following code which I copied from the source of someone else's program, however it hasn't worked:
Dim fsys As New FileSystemObject
Dim outstream As TextStream
Dim write1 As String
Dim val1 As String
val1 = Text1.Text
inisettings = App.Path & "\Variables.ini"
Set outstream = fsys.OpenTextFile(inisettings, ForWriting, False, TristateFalse)
outstream.WriteLine (val1)
Set outstream = Nothing
This is the result:
Does anyone have any way to save data for later?
FileSystemObject lives inside an external library, to use it click Project then References and tick Microsoft Scripting Runtime.
You don't actually need to do any of that, the code below uses VB's built-in functionality to write a file.
Dim hF As Integer
hF = FreeFile()
Open App.Path & "\Variables.ini" For Output As #hF
Print #hF, val1
Close #hF
You must declare TristateFalse and give it a value like 0, 1 or 2.
You can take a look at this link: https://msdn.microsoft.com/en-us/subscriptions/bxw6edd3(v=vs.84).aspx
The reason why you are getting this error is because you don't have a reference to the Microsoft Scripting Runtime library. Follow the below instructions while in your VB6 project:
From the top menu, click on Project > References.
From the list, check the item entitled "Microsoft Scripting Runtime".
Click OK.
This will resolve your immediate error however your code still has some other issues. First off, you forgot to declare the variable inisettings. I am going to assume that you will want to always overwrite the entire file each time you update the INI file so you want to use the method CreateTextFile instead of OpenTextFile.
Dim fsys As New FileSystemObject
Dim outstream As TextStream
Dim write1 As String
Dim val1 As String
Dim inisettings As String
val1 = Text1.Text
inisettings = App.Path & "\Variables.ini"
Set outstream = fsys.CreateTextFile(inisettings, True, False)
Call outstream.WriteLine(val1)
Set outstream = Nothing
Good luck!
I have both AutoCAD and AutoCAD Architecture installed on my system. AutoCAD Architecture has a tab called Vision Tools with a nifty command called Display By Layer to set the display order of objects in accordance with the layers of the drawing. Is there anyway to add this tab or use this command in AutoCAD?
Not sure if you're looking for a built-in feature or APIs for it.
For a built in feature, check the DRAWORDER command. For an API/programming approach, check the respective DrawOrderTable method. See below:
Update: please also check this 3rd party tool: DoByLayer.
[CommandMethod("SendToBottom")]
public void commandDrawOrderChange()
{
Document activeDoc
= Application.DocumentManager.MdiActiveDocument;
Database db = activeDoc.Database;
Editor ed = activeDoc.Editor;
PromptEntityOptions peo
= new PromptEntityOptions("Select an entity : ");
PromptEntityResult per = ed.GetEntity(peo);
if (per.Status != PromptStatus.OK)
{
return;
}
ObjectId oid = per.ObjectId;
SortedList<long, ObjectId> drawOrder
= new SortedList<long, ObjectId>();
using (Transaction tr = db.TransactionManager.StartTransaction())
{
BlockTable bt = tr.GetObject(
db.BlockTableId,
OpenMode.ForRead
) as BlockTable;
BlockTableRecord btrModelSpace =
tr.GetObject(
bt[BlockTableRecord.ModelSpace],
OpenMode.ForRead
) as BlockTableRecord;
DrawOrderTable dot =
tr.GetObject(
btrModelSpace.DrawOrderTableId,
OpenMode.ForWrite
) as DrawOrderTable;
ObjectIdCollection objToMove = new ObjectIdCollection();
objToMove.Add(oid);
dot.MoveToBottom(objToMove);
tr.Commit();
}
ed.WriteMessage("Done");
}
With some help from VBA it might look by this. Note i did not add fancy listbox code. I just show the worker and how to list layers. The trivial Code to add things to a listbox on a form and how to sort / rearrange listbox items can be found on any excel / VBA forum on the web . Or you just uses a predefined string like in the example. To get VBA to work download and install the acc. VBA Enabler from autocad. It is free.
'select all items on a layer by a filter
Sub selectALayer(sset As AcadSelectionSet, layername As String)
Dim filterType As Variant
Dim filterData As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim grpCode(0) As Integer
grpCode(0) = 8
filterType = grpCode
Dim grpValue(0) As Variant
grpValue(0) = layername
filterData = grpValue
sset.Select acSelectionSetAll, p1, p2, filterType, filterData
Debug.Print "layer", layername, "Entities: " & str(sset.COUNT)
End Sub
'bring items on top
Sub OrderToTop(layername As String)
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim i As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.COUNT - 1
If ThisDrawing.SelectionSets.ITEM(i).NAME = setName Then
ThisDrawing.SelectionSets.ITEM(i).DELETE
Exit For
End If
Next i
setName = "tmp_" & time()
Set oSset = ThisDrawing.SelectionSets.Add(setName)
Call selectALayer(oSset, layername)
If oSset.COUNT > 0 Then
ReDim arrObj(0 To oSset.COUNT - 1) As ACADOBJECT
'Process each object
i = 0
For Each oEnt In oSset
Set arrObj(i) = oEnt
i = i + 1
Next
End If
'kills also left over selectionset by programming mistakes....
For Each selectionset In ThisDrawing.SelectionSets
selectionset.delete_by_layer_space
Next
On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.modelspace.GetExtensionDictionary
' Prevent failed GetObject calls from throwing an exception
On Error Resume Next
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
On Error GoTo 0
If sentityObj Is Nothing Then
' No SortentsTable object, so add one
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
applicaTION.UPDATE
Exit Sub
Err_Control:
If ERR.NUMBER > 0 Then MsgBox ERR.DESCRIPTION
End Sub
Sub bringtofrontbylist()
Dim lnames As String
'predefined layer names
layer_names = "foundation bridge road"
Dim h() As String
h = split(layernames)
For i = 0 To UBound(h)
Call OrderToTop(h(i))
Next
End Sub
'in case you want a fancy form here is how to get list / all layers
Sub list_layers()
Dim LAYER As AcadLayer
For Each LAYER In ThisDrawing.LAYERS
Debug.Print LAYER.NAME
Next
End Sub
to make it run put the cursor inside the VBA IDE inside the code of list_layers andpress F5 or choose it from the VBA Macro list.
I have absolutely no experience programming in excel vba other than I wrote a function to add a data stamp to a barcode that was scanned in on our production line a few weeks back, mainly through trial and error.
Anyways, what I need help with right now is inventory is coming up and every item we have has a barcode and is usually scanned into notepad and then manually pulled into excel and "text to columns" is used. I found the excel split function and would like a little bit of help getting it to work with my scanned barcodes.
The data comes in in the format: 11111*A153333*11/30/11 plus a carriage return , where the * would be the delimiter. All the examples I've found don't seem to do anything, at all.
For example here is one I found on splitting at the " ", but nothing happens if I change it to *.
Sub splitText()
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(ActiveCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
End Sub
And this is applied in the Sheet1 code section, if that helps.
It really can't be this complicated, can it?
Edit: Trying to add in Vlookup to the vba.
So as I said below in the comments, I'm now working on getting the vlookup integrated into this, however it just returns N/A.
Here is the sub I wrote based on the link below
Public Sub vlook(ByRef codeCell As Range)
Dim result As String
Dim source As Worksheet
Dim destination As Worksheet
Set destination = ActiveWorkbook.Sheets("Inventory")
Set source = ActiveWorkbook.Sheets("Descriptions")
result = [Vlookup(destination!(codeCell.Row, D), source!A2:B1397, 2, FALSE)]
End Sub
And I was trying to call it right after the For loop in the worksheet change, and just created another for loop, does this/should this be a nested for loop?
Just adding the code to the VBA behind the worksheet won't actually cause it to get called. You need to handle the worksheet_change event. The following should help:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim cell As Range
For Each cell In Target.Cells
If cell.Column = 1 Then SplitText cell
Next
Application.EnableEvents = True
End Sub
Public Sub SplitText(ByRef codeCell As Range)
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(codeCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(codeCell.Row, codeCell.Column), Cells(codeCell.Row, codeCell.Column + totalVals)).Value = splitVals
End Sub
If you want to process the barcodes automatically on entering them, you need something like this (goes in the worksheet module).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim splitVals As Variant
Dim c As Range, val As String
For Each c In Target.Cells
If c.Column = 1 Then 'optional: only process barcodes if in ColA
val = Trim(c.Value)
If InStr(val, "*") > 0 Then
splitVals = Split(val, "*")
c.Offset(0, 1).Resize( _
1, (UBound(splitVals) - LBound(splitVals)) + 1 _
).Value = splitVals
End If
End If 'in ColA
Next c
End Sub