[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

Auto Resizing Font in a Textbox

Posted on 2010-03-22
26
Medium Priority
?
821 Views
Last Modified: 2012-05-09
In Word 2002 / Word 2003 I need to make a textbox 0.875 inches Height x 3 inches Width to type different phrases into it one letter at a time.  I would like the font size of my letters to fill the textbox so that they grow larger or smaller as I delete or add letters / words to the textbox.

When I have finished typing my information I would like to copy it from the textbox to the Windows clipboard so it can be pasted into a different unrelated piece of software and I would also like to be notified via a messagebox of the final font size of my text so I can enter that information into the second piece of software as well.

My question here relates to the Word 2002 /  Word 2003 end of things.  Getting the information into the second unrelated piece of software is something I will work on or I will post it as a problem in another question.

Thank you.

Mitch
0
Comment
Question by:spinningtop
  • 8
  • 8
  • 7
23 Comments
 
LVL 12

Expert Comment

by:satsumo
ID: 28351663
Just to clarify, are you wanting the letters of the word to stretch to fit the box, or maintain their shape and just grow/shrink to fit?  If you make the box four times taller and keep the same width, should the text become four times taller too?
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 28361071
Mitch,
See Steve Lebans free autosize textbox at his link:
              http://www.lebans.com/autosize_textbox.htm
0
 

Author Comment

by:spinningtop
ID: 28405505
Satsumo - Thank you for your reply.  I want the text to maintain its shape and just grow/shrink to fit the textbox.  The text should not be distorted from its original shape, so if I make the textbox four times taller the text should not grow four times taller unless it can go wide enough to maintain its original proportions.  Thank you.

Mitch
0
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 

Author Comment

by:spinningtop
ID: 28492695
puppydogbuddy,

Thank you for your reply.  The Steve Lebans link shows how to change the textbox to fit the text size.  But I want to change the text size to fit the textbox which is the reverse of what Steve Lebans proposes.

Mitch
0
 

Author Comment

by:spinningtop
ID: 28767093
All,

I hope I am not making this sound more difficult than it needs to be.  I simply wish to automatically expand / shrink text I type to fit a textbox of fixed size without distorting the text.

I think both Word and Excel offer a function to fit a textbox to text, but they don't offer a function to fit text to a textbox which is unfortunately what I need.

Any help would be appreciated.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 28771260
Try another Lebans function code:
               http://www.lebans.com/limittextinput.htm
I know it is not exactly what you want,but should be a lot closer to what you want....something you can build on.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 28778615
Here is a reference to the clipboard functions you you wanted:
                     http://allenbrowne.com/func-07b.html

Also, try this code I adapted from code written by "Marsh".  His code was written for a textbox on a report.  I am trying to adapt for a textbox on a form. If it doesn't work in the textbox's change event, I will have try somehing else.

Private Sub YourTextbox_Change()
Dim fs As Integer
For fs = 14 To 5 Step -1
If TextWidth(Me.thetextbox) < Me.thetextbox.Width Then
Exit For
End If
Next fs
Me.thetextbox.FontSize = fs
End Sub
0
 
LVL 12

Expert Comment

by:satsumo
ID: 28779486
I don't know of a function (in Windows) that will tell you what font size will show some text at a specific width.  You can find out how wide a piece of text is with a specific font.  You'd have to do a kind of search for the correct size.

Starting at size x, find the width of your text.  If its too wide, make x smaller, if its too narrow make x bigger.

The text width should scale quite accurately with font size.  If the box is 240 pixels wide and your text is 160  pixels wide at 12 point, then the 18 point version of your text should be nearly 240 pixels wide.  

However, you won't find a specific match of point size and box width very often.  If you want to improve the fit you can justify the text or add spacing to the font.

I could write a loop for this in C (or some kind of pseudocode) using windows API calls, if that would help.  Its a long time since I used VB.

You'd have to do this search whenever the text in the text box changed.  You don't mention whether you need multi-line text or not, that would complicate somewhat.
0
 

Author Comment

by:spinningtop
ID: 28794043
puppydogbuddy,

Thank you for your reply.  TextWidth is a valid function in VB, but not VBA which is where I will be implementing the code.  Do you know of a workaround for VBA?
0
 

Author Comment

by:spinningtop
ID: 28794168
satsumo,

Thank you for your reply.  Do you know what function or code to use to get the textwidth?
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 28797100
Lebans has it (freely available source code)!
view see:    http://www.lebans.com/textwidth-height.htm

TextHeightWidth.zip is a replacement for the Report object's TextWidth
and TextHeight methods. It is multiline aware and can work in both
Report and Form views. Includes a sample report to show you how to
autosize individual controls with different formatting on the same line
to simulate RTF style text.


0
 

Author Comment

by:spinningtop
ID: 28806514
puppydogbuddy,

Thank you for your reply.  This is written for an Access database.  Do you know if it will work for VBA?
0
 
LVL 12

Assisted Solution

by:satsumo
satsumo earned 1000 total points
ID: 28828365
The related functions in the API are -

BOOL GetTextExtentPoint32 (HDC hdc, LPCTSTR lpString, int cbString, LPSIZE lpSize);
int SetTextCharacterExtra (HDC hdc, int nCharExtra);
BOOL SetTextJustification (HDC hdc, int nBreakExtra, int nBreakCount);

Good documentation of each of these functions can be found in the online MSDN.

http://msdn.microsoft.com/en-us/library/dd144938%28VS.85%29.aspx
http://msdn.microsoft.com/en-us/library/dd145092%28VS.85%29.aspx
http://msdn.microsoft.com/en-us/library/dd145094%28VS.85%29.aspx

If you can get some kind of device context object through VBA, it may have methods that match these functions.  There is usually a strong correspondance between wrapper objects and the underlying API.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 28836847
it should. For one thing, Access operates within an integrated Development Environment (IDE), which includes VBA.  Secondly,Lebans packages his VBA code in user defined functions (UDF's) and API''s.  You should be able to use ok
0
 

Author Comment

by:spinningtop
ID: 28881364
puppydogbuddy,

I really appreciate your help.  I tried downloading Lebans package, but since I don't have Access on this computer I can't download it.  Any ideas on how to get this code.  Also, the code needs to run in a VBA.environment

Thanks for your help.

Mitch
0
 
LVL 38

Accepted Solution

by:
puppydogbuddy earned 1000 total points
ID: 28893901
Mitch,
I downloaded the file, copied and pasted it for you below.  As stated the MS Access code is written in vb6, which should be compatible to VBA with little or minmal modification.  Here is an excerpt from the Wikipedia on VBA.       http://en.wikipedia.org/wiki/Visual_Basic_for_Applications
Visual Basic for Applications (VBA) is an implementation of Microsoft's event-driven programming language Visual Basic 6, and associated integrated development environment (IDE), which is built into most Microsoft Office applications. VBA enables developers to build user defined functions, automate processes, and access Win32 and other low level functionality through DLLs.


________________Form class module code (from sample Customer form)______________________


Option Compare Database
Option Explicit

' Copyright Lebans Holdings 1999 Ltd.
' Stephen @lebans.com

' Flag for Autosizing
Private blAuto As Boolean
' Initial Height of Memo control
Private lngInitMemoHeight As Long
' Initial Widths of controls
Private lngInitCusIDwidth As Long
Private lngInitCusNamewidth As Long
Private lngInitCusnumwidth As Long


Private Sub Form_Current()
' Let's call our function to determine the
' Width or Height for the contents of each control.
' The function uses the Control's Font settings
' to determine the Width/Height of the
' contents of the control. You can
' optionally pass a string directly to the function
' but you must always include a control setup
' with the font settings you want applied to
' the text.
' You may also optionally pass by reference two
' long variables that the function will return the
' string width and height.
Me.txtCusIDWidth = fTextWidth(Me.CusID)
Me.txtCusNameWidth = fTextWidth(Me.CusName)
Me.txtCusNumWidth = fTextWidth(Me.Cusnum)


' Pass optional vars to return both Width and Height
Dim lngWidth As Long, lngHeight As Long, lngTotalLines As Long, lngRet As Long
lngRet = fTextHeight(Me.testmemo, , lngHeight, lngWidth, lngTotalLines)
Me.txtMemoHeight = lngHeight
Me.txtMemoWidth = lngWidth
Me.txtTotalLines = lngTotalLines

If blAuto Then
' Enable autosizing of each control
Dim lngTopMargin As Long
Dim sngMargin As Single
' Margins of TextBox.
' Percentage of StringWindth for let and right margins.
sngMargin = 0.02
' Fixed Top Margin of TextBox
lngTopMargin = 60


With Me.CusID
.Width = fTextWidth(Me.CusID)
.Width = .Width + IIf(((.Width * sngMargin) < 100), 100, .Width * sngMargin)
End With
With Me.CusName
.Width = fTextWidth(Me.CusName)
.Width = .Width + IIf(((.Width * sngMargin) < 100), 100, .Width * sngMargin)
End With
With Me.Cusnum
.Width = fTextWidth(Me.Cusnum)
.Width = .Width + IIf(((.Width * sngMargin) < 100), 100, .Width * sngMargin)
End With


' Exit if we are on a new record
If Me.NewRecord Then
' Restore control's original height
Me.testmemo.Height = lngInitMemoHeight
Exit Sub
End If
With Me.testmemo
.Height = lngHeight + lngTopMargin
End With
End If
End Sub

Private Sub cmdOn_Click()
' Turn on Autosizing
blAuto = True
Call Form_Current
End Sub

Private Sub cmdOff_Click()
' Turn off Autosizing
blAuto = False
' Restore the control's original dimensions
Me.testmemo.Height = lngInitMemoHeight
Me.CusID.Width = lngInitCusIDwidth
Me.Cusnum.Width = lngInitCusnumwidth
Me.CusName.Width = lngInitCusNamewidth
Call Form_Current
End Sub

Private Sub Form_Load()
' Save the control's original dimensions
lngInitMemoHeight = Me.testmemo.Height
lngInitCusIDwidth = Me.CusID.Width
lngInitCusNamewidth = Me.CusName.Width
lngInitCusnumwidth = Me.Cusnum.Width

' Turn Autosizing On
blAuto = True

Call Form_Current
End Sub



--------------------------Standard Module Code And assocated API Declarations-----------------------------
Option Compare Database


Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Const LF_FACESIZE = 32

Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * LF_FACESIZE
End Type

Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type

Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _
(ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long

Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" _
(ByVal hDC As Long, _
ByVal hObject As Long) As Long

Private Declare Function apiDeleteObject Lib "gdi32" _
Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" _
(ByVal nNumber As Long, _
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function apiGetDC Lib "user32" _
Alias "GetDC" (ByVal hwnd As Long) As Long

Private Declare Function apiReleaseDC Lib "user32" _
Alias "ReleaseDC" (ByVal hwnd As Long, _
ByVal hDC As Long) As Long

Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" _
(ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long

Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long 'DEVMODE) As Long

Private Declare Function apiDeleteDC Lib "gdi32" _
Alias "DeleteDC" (ByVal hDC As Long) As Long

Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long




' CONSTANTS
Private Const TWIPSPERINCH = 1440
' Used to ask System for the Logical pixels/inch in X & Y axis
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88

' DrawText() Format Flags
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_EDITCONTROL = &H2000&
Private Const DT_NOCLIP = &H100



' Font stuff
Private Const OUT_DEFAULT_PRECIS = 0
Private Const OUT_STRING_PRECIS = 1
Private Const OUT_CHARACTER_PRECIS = 2
Private Const OUT_STROKE_PRECIS = 3
Private Const OUT_TT_PRECIS = 4
Private Const OUT_DEVICE_PRECIS = 5
Private Const OUT_RASTER_PRECIS = 6
Private Const OUT_TT_ONLY_PRECIS = 7
Private Const OUT_OUTLINE_PRECIS = 8

Private Const CLIP_DEFAULT_PRECIS = 0
Private Const CLIP_CHARACTER_PRECIS = 1
Private Const CLIP_STROKE_PRECIS = 2
Private Const CLIP_MASK = &HF
Private Const CLIP_LH_ANGLES = 16
Private Const CLIP_TT_ALWAYS = 32
Private Const CLIP_EMBEDDED = 128

Private Const DEFAULT_QUALITY = 0
Private Const DRAFT_QUALITY = 1
Private Const PROOF_QUALITY = 2

Private Const DEFAULT_PITCH = 0
Private Const FIXED_PITCH = 1
Private Const VARIABLE_PITCH = 2

Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const CHINESEBIG5_CHARSET = 136
Private Const OEM_CHARSET = 255
'

Public Function fTextHeight(ctl As Control, _
Optional ByVal sText As String = "", _
Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
Optional TotalLines As Long = 0, _
Optional TwipsPerPixel As Long = 0) As Long

On Error Resume Next

' Call our function to calculate TextHeight
' If blWH=TRUE then we are TextHeight
fTextHeight = fTextWidthOrHeight(ctl, True, _
sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)

End Function


Public Function fTextWidth(ctl As Control, _
Optional ByVal sText As String = "", _
Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
Optional TotalLines As Long = 0, _
Optional TwipsPerPixel As Long = 0) As Long

On Error Resume Next

' If blWH=FALSE then we are TextWidth
' Call our function to calculate TextWidth
fTextWidth = fTextWidthOrHeight(ctl, False, _
sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)

End Function


Public Function fTextWidthOrHeight(ctl As Control, ByVal blWH As Boolean, _
Optional ByVal sText As String = "", _
Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
Optional TotalLines As Long = 0, _
Optional TwipsPerPixel As Long = 0) As Long

'Name FUNCTION() fTextWidthOrHeight
'
'Purpose: Returns the Height or Width needed to
' display the contents of the Control passed
' to this function. This function
' uses the Control's font attributes to build
' a Font for the required calculations.
'
' This function replaces the Report object's TextHeight
' and TextWidth methods which only work for a single line of text.
' This function works with multiple lines of text and
' also with both Forms and Reports.
'
'Version: 4.1
'
'Calls: Text API stuff. DrawText performs the actual
' calculation to determine Control Height.
'
'Returns: Height or width of Control in TWIPS required
' to display current contents.
'
'Created by: Stephen Lebans
'
'Credits: If you want some...take some.
'
'Date: May 22, 2001
'
'Time: 10:10:10pm
'
'Feedback: Stephen@lebans.com
'
'My Web Page: www.lebans.com
'
'Copyright: Lebans Holdings Ltd.
' Please feel free to use this code
' without restriction in any application you develop.
' This code may not be resold by itself or as
' part of a collection.
'
'What's Missing: Let me know!
'
'
'
'Bugs:
'None at this point.
'
'Enjoy
'Stephen Lebans

'***************Code Start***************

' Structure for DrawText calc
Dim sRect As RECT

' Reports Device Context
Dim hDC As Long

' Holds the current screen resolution
Dim lngDPI As Long

Dim newfont As Long
' Handle to our Font Object we created.
' We must destroy it before exiting main function

Dim oldfont As Long
' Device COntext's Font we must Select back into the DC
' before we exit this function.

' Temporary holder for returns from API calls
Dim lngRet As Long

' Logfont struct
Dim myfont As LOGFONT

' TextMetric struct
Dim tm As TEXTMETRIC

' LineSpacing Amount
Dim lngLineSpacing As Long

' Ttemp var
Dim numLines As Long

' Temp string var for current printer name
Dim strName As String

' Temp vars
Dim sngTemp1 As Single
Dim sngTemp2 As Single

On Error GoTo Err_Handler

' If we are being called from a Form then SKIP
' the logic to Create a Printer DC and simply use
' the Screen's DC

If TypeOf ctl.Parent Is Access.Report Then
' ***************************************************
' Warning! Do not use Printer's Device Context for Forms.
' This alternative is meant for Report's only!!!!!
' For a Report the best accuracy is obtained if you get a handle to
' the printer's Device Context instead of the Screen's.
' You can uncomment his code and comment out the
' apiGetDc line of code.
' We need to use the Printer's Device Context
' in order to more closely match Font height calcs
' with actual ouptut. This example simply uses the
' default printer for the system. You could also
' add logic to use the Devnames property if this
' report prints to a specific printer.
strName = GetDefaultPrintersName
hDC = CreateDCbyNum("WINSPOOL", strName, 0&, 0&)
If hDC = 0 Then
' Error cannot get handle to printer Device Context
Err.Raise vbObjectError + 255, "fTextWidthOrHeight", "Cannot Create Printer DC"
End If
' ***************************************************
Else
' Get handle to screen Device Context
hDC = apiGetDC(0&)
End If

' Were we passed a valid string
If Len(sText & vbNullString) = 0 Then
' Did we get a valid control passed to us?
'select case typeof ctl is
Select Case ctl.ControlType

Case acTextBox
sText = Nz(ctl.Value, vbNullString)

Case acLabel, acCommandButton
sText = Nz(ctl.Caption, vbNullString)

Case acListBox
sText = Nz(ctl.ItemData(0), vbNullString)

Case Else
' Fail - not a control we can work with
fTextWidthOrHeight = 0
Exit Function
End Select
End If


' Get current device resolution
' blWH=TRUE then we are TextHeight
If blWH Then
lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSY)
Else
lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSX)
End If

' Calculate TwipsPerPixel
TwipsPerPixel = TWIPSPERINCH / lngDPI

' We use a negative value to signify
' to the CreateFont function that we want a Glyph
' outline of this size not a bounding box.
' Copy font stuff from Text Control's property sheet
With ctl
myfont.lfClipPrecision = CLIP_LH_ANGLES
myfont.lfOutPrecision = OUT_TT_ONLY_PRECIS
myfont.lfEscapement = 0
myfont.lfFaceName = .FontName & Chr$(0)
myfont.lfWeight = .FontWeight
myfont.lfItalic = .FontItalic
myfont.lfUnderline = .FontUnderline
'Must be a negative figure for height or system will return
'closest match on character cell not glyph
myfont.lfHeight = (.FontSize / 72) * -lngDPI
' Create our temp font
newfont = apiCreateFontIndirect(myfont)
End With

If newfont = 0 Then
Err.Raise vbObjectError + 256, "fTextWidthOrHeight", "Cannot Create Font"
End If

' Select the new font into our DC.
oldfont = apiSelectObject(hDC, newfont)
' Use DrawText to Calculate height of Rectangle required to hold
' the current contents of the Control passed to this function.
With sRect
.Left = 0
.Top = 0
.Bottom = 0
' blWH=TRUE then we are TextHeight
If blWH Then
.Right = (ctl.Width / (TWIPSPERINCH / lngDPI)) - 10
Else
' Single line TextWidth
.Right = 32000
End If

' Calculate our bounding box based on the controls current width
lngRet = apiDrawText(hDC, sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
DT_LEFT Or DT_WORDBREAK Or DT_EXTERNALLEADING Or DT_EDITCONTROL Or DT_NOCLIP)

' Get TextMetrics. This is required to determine
' Text height and the amount of extra spacing between lines.
lngRet = GetTextMetrics(hDC, tm)

' Cleanup
lngRet = apiSelectObject(hDC, oldfont)
' Delete the Font we created
apiDeleteObject (newfont)

If TypeOf ctl.Parent Is Access.Report Then
' ***************************************************
' If you are using the Printers' DC then uncomment below
' and comment out the apiReleaseDc line of code below
' Delete our handle to the Printer DC
lngRet = apiDeleteDC(hDC)
' ***************************************************
Else
' Release the handle to the Screen's DC
lngRet = apiReleaseDC(0&, hDC)
End If

' Calculate how many lines we are displaying
' return to calling function. The GDI incorrectly
' calculates the bounding rectangle because
' of rounding errors converting to Integers.
TotalLines = .Bottom / (tm.tmHeight + tm.tmExternalLeading)
numLines = TotalLines

' Convert RECT values to TWIPS
.Bottom = (.Bottom) * (TWIPSPERINCH / lngDPI) 'sngTemp2 ' + 20

' ***************************************************
' For A2K only!
' Now we need to add in the amount of the
' line spacing property.
'lngLineSpacing = ctl.LineSpacing * (numLines - 1)
'If numLines = 1 Then lngLineSpacing = lngLineSpacing + (ctl.LineSpacing / 2)
' Increase our control's height accordingly
'.Bottom = .Bottom + lngLineSpacing


' Return values in optional vars
' Convert RECT Pixel values to TWIPS
HeightTwips = .Bottom '* (TWIPSPERINCH / lngDPI)
WidthTwips = .Right * (TWIPSPERINCH / lngDPI) '(apiGetDeviceCaps(hDC, LOGPIXELSX)))

' blWH=TRUE then we are TextHeight
If blWH Then
fTextWidthOrHeight = HeightTwips
Else
fTextWidthOrHeight = WidthTwips
End If
End With

' Exit normally
Exit_OK:
Exit Function

Err_Handler:
Err.Raise Err.Source, Err.Number, Err.Description
Resume Exit_OK
End Function

Function GetDefaultPrintersName() As String
' This function is from Peter Walker.
' Check out his web site at:
' http://www.users.bigpond.com/papwalker/
Dim success As Long
Dim nSize As Long
Dim lpKeyName As String
Dim ret As String
Dim posDriver
'call the API passing null as the parameter
'for the lpKeyName parameter. This causes
'the API to return a list of all keys under
'that section. Pad the passed string large
'enough to hold the data. Adjust to suit.
ret = Space$(8102)
nSize = Len(ret)
success = GetProfileString("windows", "device", "", ret, nSize)
posDriver = InStr(ret, ",")
GetDefaultPrintersName = Left$(ret, posDriver - 1)
End Function

Open in new window

0
 
LVL 12

Expert Comment

by:satsumo
ID: 32506310
I think puppydogbuddy provided an answer in comment #28893901. This just hasn't been confirmed by spinningtop.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 32509682
Thanks satsumo.  I think we both collaborated to answer spinningtop's questions, and that any points awarded should be split evenly between us.  
0
 
LVL 12

Expert Comment

by:satsumo
ID: 32529255
Thanks puppydogbuddy.  In the case of a split I would still suggest that you should get more points than me.  Even measured simply by the number of responses your contribution is larger.
0
 

Author Comment

by:spinningtop
ID: 32856659
Sorry I have been away...

puppydogbuddy - I tried your 587 lines of code, but it does not work right out of the box.  I get all kinds of error messages when I try to run it in Word.

This should be a relatively easy thing to do.  IMHO it should not require 587 lines of code, just to automatically resize text to fit a textbox in VBA

Satsumo -  I'm sorry, but I don't know API and do not have the time to learn it right now.

0
 
LVL 12

Expert Comment

by:satsumo
ID: 32873250
Understood, I dont know VBA though I did work with VB for a few years.  Generally there is a good correspondance between functions in the API and methods in VB (after all, VB is largely an interface to the API).  If you don't get a workable VBA specific answer I could probably provide some pseudocode.
0
 
LVL 12

Expert Comment

by:satsumo
ID: 32922911
As stated above, puppydogbuddy has provided an answer in comment #28893901.  The problems the asker has will be differences in syntax.  The method will be the same no matter what language is used.  The code given may be useful to someone else searching for the same answer.

 I also think that some (or all) of the points should go to puppydogbuddy.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
ID: 32923167
I object to the question being deleted, also.  The answers given by me under comment #28893901 and by Satsumo in comment #28828365 are the correct answers in the context of a VBA solution, and therefore, the question should be closed and the points should be split among the 2 experts that provided their input. The syntax of the code provided in comment # 28893901, which includes the required API modules, may need minor changes in syntax and the addition of some VBA library references in order for it to compile in the Word VBA editor, but the asker did not want to bother with API's or with the debugging process.      
0

Featured Post

[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Ever visit a website where you spotted a really cool looking Font, yet couldn't figure out which font family it belonged to, or how to get a copy of it for your own use? This article explains the process of doing exactly that, as well as showing how…
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

591 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question