Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

problem zellen-format (tabelle einfügen)

Betrifft: problem zellen-format (tabelle einfügen) von: arni
Geschrieben am: 02.09.2004 18:59:04

Hallo zusammen !!
Hat irgendjemand eine idee, wie man in excel eine zelle so formatieren kann, dass man als kommentar eine tabelle einfügen kann (word oder excel) ??
.. oder vielleicht einen anderen Lösungsweg dafür ??
Gruß
arni

  


Betrifft: AW: problem zellen-format (tabelle einfügen) von: yps
Geschrieben am: 02.09.2004 19:43:03

hi,
du willst also eine komplette tabelle in einen kommentar zu einer zelle einfügen ?
das höchste der gefühle wäre nach meiner unmassgeblichen meinung eine grafik und über das laufzeitverhalten einer solchen riesengrafik (die ja auch noch lesbar sein soll) mag ich momentan nicht nachdenken
cu Micha


  


Betrifft: AW: problem zellen-format (tabelle einfügen) von: WF
Geschrieben am: 02.09.2004 20:22:06

Dim container As Chart
Public containerbok As Workbook
Dim Obnavn As String
Dim Sourcebok As Workbook
Public xPath As String

Sub Comment_Fill()
Range("B2").Select
Range("B2").AddComment
Range("B2").Comment.Text Text:=""
With Selection.Comment.Shape
.Fill.UserPicture xPath
End With
End Sub

Function SelectArea() As String
Dim Internrange As Range
On Error GoTo Brutt
Set Internrange = Application.InputBox("Select " _
& "range to be photographed:", "Picture Selection", _
Selection.AddressLocal, Type:=8)
SelectArea = Internrange.Address
Exit Function
Brutt:
SelectArea = "A1"
End Function

Function sShortname(ByVal Orrginal As String) As String
Dim iii As Integer
sShortname = ""
For iii = 1 To Len(Orrginal)
If Mid(Orrginal, iii, 1) <> " " Then _
sShortname = sShortname & Mid(Orrginal, iii, 1)
Next
End Function

Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
ActiveChart.Location Where:=xlLocationAsObject, _
	Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub


Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Hincrease As Single
Dim Vincrease As Single
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft
Vincrease = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft
End Sub

Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long
Set Sourcebok = ActiveWorkbook
MySuggest = sShortname(ActiveSheet.Name)
ImageContainer_init
Sourcebok.Activate
MyAddress = SelectArea
If MyAddress <> "A1" Then
SaveName = Application.GetSaveAsFilename( _
initialfilename:=MySuggest _
& ".gif", fileFilter:="Gif Files (*.gif), *.gif")
Range(MyAddress).Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
If SaveName = False Then
GoTo Avbryt
End If
If InStr(SaveName, ".") Then SaveName _
= Left(SaveName, InStr(SaveName, ".") - 1)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 4
Wi = Selection.Width + 6
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
xPath = LCase(SaveName) & ".gif"
ActiveChart.Export Filename:=xPath, FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
End If
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Saved = True
containerbok.Close
Call Comment_Fill
End Sub


 

Beiträge aus den Excel-Beispielen zum Thema "problem zellen-format (tabelle einfügen)"